R
Rocky
New to writing VBA code and am stumped in trying to figure out why the error
message keeps saying, "Could not find file "General Thoracic.mdb" when the
file is obivously open because I am switching to the VBA editor using the
Alt+F11 toggle. Here is the code:
(by the way, it's probably obvious, but the code is a hodgepodge of cut and
paste)
'this procedure creates a database
Sub CreateTableDefX()
Dim dbsGeneralThoracic As Database
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim fldName As Field
Dim recno As Long
Set dbsGeneralThoracic = CurrentDb
Set dbsGeneralThoracic = OpenDatabase("General Thoracic.mdb")
DoCmd.OpenQuery "acqryProcSpecImport"
' Create a new TableDef object.
Set tdfNew = dbsGeneralThoracic.CreateTableDef("tblProcedures")
recno = 1
Do While recno < 125
DoCmd.GoToRecord acqryProcSpecImport, "Procedure", acGoTo, recno
Set fldName = Procedure
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' GeneralThoracic database.
.Fields.Append .CreateField("fldName", dbText)
Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
' Append the new TableDef object to the Northwind
' database.
dbsGeneralThoracic.TableDefs.Append tdfNew
Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
End With
recno = recno + 1
Loop
End Sub
message keeps saying, "Could not find file "General Thoracic.mdb" when the
file is obivously open because I am switching to the VBA editor using the
Alt+F11 toggle. Here is the code:
(by the way, it's probably obvious, but the code is a hodgepodge of cut and
paste)
'this procedure creates a database
Sub CreateTableDefX()
Dim dbsGeneralThoracic As Database
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim fldName As Field
Dim recno As Long
Set dbsGeneralThoracic = CurrentDb
Set dbsGeneralThoracic = OpenDatabase("General Thoracic.mdb")
DoCmd.OpenQuery "acqryProcSpecImport"
' Create a new TableDef object.
Set tdfNew = dbsGeneralThoracic.CreateTableDef("tblProcedures")
recno = 1
Do While recno < 125
DoCmd.GoToRecord acqryProcSpecImport, "Procedure", acGoTo, recno
Set fldName = Procedure
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' GeneralThoracic database.
.Fields.Append .CreateField("fldName", dbText)
Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
' Append the new TableDef object to the Northwind
' database.
dbsGeneralThoracic.TableDefs.Append tdfNew
Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
End With
recno = recno + 1
Loop
End Sub