C
cnVivian
Guest
I designed a program that imports an excel file with 30 spreadsheets into an existing ACC2000 table(Test1) at a time. I also need to take each spreadsheet names and added into the field F1. The spreadsheet are named like 3-3-03, 3-4-03, 3-5-03, and so on. they are DATE type in F1. The field F1 is first column in each of spreadsheet of the excile file. Some of cells are blank in the first column. (The spreadsheets are multiple headings, I set up range as A7:T110, but it's not case here.)
My program works for importing all spreadsheets at a time so far, but not adding spreadsheet name in the field F1. I wrote some code within the loop of spreadsheet importing that is supposed to add the names after importing a spreadsheet in to the table Test1 and before moving to next spreadsheet.
I currently received the Run-time error message'13': Variable 'Test1' couldn't not found, pertaining to the line: rst.Open Test1, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'*************************************************************************
'** OPEN DIALOG BOX TO SELECT AN EXCEL FILE. **
'** IMPORTING MULTIPLE SPREADSHEETS **
'** AND ADDING SPREADSHEET NAME IN THE FIRST FIELD AT A TIME. **
'*************************************************************************
Private Sub Import_xls_Click()
Dim strSQL As String
Dim stDocName As String
Dim xlWorkbook As Excel.Workbook
Dim Intcounter As Integer
Dim strFilename As String
Dim eachSheetName As String
Dim myRange As String
Dim oAccess As Access.Application
Dim i As Integer
Dim strSheetName As String
DoCmd.SetWarnings False
'Delete Table Import
strSQL = "Delete tbl_Test from tbl_Test"
DoCmd.RunSQL (strSQL)
'import xls
'This is for the GetOpenFileName function in comdlg32.dll(public vaiables)
strFilename = BrowseFile("C:\", ".xls")
Set xlWorkbook = Excel.Workbooks.Open(strFilename)
Intcounter = xlWorkbook.Sheets.Count
i = 1 'initialize the counter and starts the loop.
Do Until i = Intcounter + 1
'Sheet Name and Range
strSheetName = xlWorkbook.Sheets(i).Name
eachSheetName = strSheetName + "$"
myRange = eachSheetName + "A7:T110"
DoCmd.TransferSpreadsheet acImport, 8, "Test1", strFilename, False, myRange
'***** try to insert the spreadsheet name in a new field code ********
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim tbl As New ADOX.Table
Set cnn = CurrentProject.Connection
With cnn
rst.Open Test1, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
With rst
While Not rst.EOF
rst.Move 7
.Edit
.Fields("Release").Value = eachSheetName
.Update
rst.MoveNext
End With
Wend
End With
Set rst = Nothing
End With
Set cnn = Nothing
i = i + 1
Loop
xlWorkbook.Close
Set xlWorkbook = Nothing
End Sub
My program works for importing all spreadsheets at a time so far, but not adding spreadsheet name in the field F1. I wrote some code within the loop of spreadsheet importing that is supposed to add the names after importing a spreadsheet in to the table Test1 and before moving to next spreadsheet.
I currently received the Run-time error message'13': Variable 'Test1' couldn't not found, pertaining to the line: rst.Open Test1, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'*************************************************************************
'** OPEN DIALOG BOX TO SELECT AN EXCEL FILE. **
'** IMPORTING MULTIPLE SPREADSHEETS **
'** AND ADDING SPREADSHEET NAME IN THE FIRST FIELD AT A TIME. **
'*************************************************************************
Private Sub Import_xls_Click()
Dim strSQL As String
Dim stDocName As String
Dim xlWorkbook As Excel.Workbook
Dim Intcounter As Integer
Dim strFilename As String
Dim eachSheetName As String
Dim myRange As String
Dim oAccess As Access.Application
Dim i As Integer
Dim strSheetName As String
DoCmd.SetWarnings False
'Delete Table Import
strSQL = "Delete tbl_Test from tbl_Test"
DoCmd.RunSQL (strSQL)
'import xls
'This is for the GetOpenFileName function in comdlg32.dll(public vaiables)
strFilename = BrowseFile("C:\", ".xls")
Set xlWorkbook = Excel.Workbooks.Open(strFilename)
Intcounter = xlWorkbook.Sheets.Count
i = 1 'initialize the counter and starts the loop.
Do Until i = Intcounter + 1
'Sheet Name and Range
strSheetName = xlWorkbook.Sheets(i).Name
eachSheetName = strSheetName + "$"
myRange = eachSheetName + "A7:T110"
DoCmd.TransferSpreadsheet acImport, 8, "Test1", strFilename, False, myRange
'***** try to insert the spreadsheet name in a new field code ********
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim tbl As New ADOX.Table
Set cnn = CurrentProject.Connection
With cnn
rst.Open Test1, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
With rst
While Not rst.EOF
rst.Move 7
.Edit
.Fields("Release").Value = eachSheetName
.Update
rst.MoveNext
End With
Wend
End With
Set rst = Nothing
End With
Set cnn = Nothing
i = i + 1
Loop
xlWorkbook.Close
Set xlWorkbook = Nothing
End Sub
This would have been a really good thread to share if there were a resolution. I've got a loops through tables at the moment while looping through records to look for an update date. Now I'm working on looping through tables and looking through certain records to export to excel. I'm snagged on the export to an existing excel file and once I get over this hump, I will need to be able to import as well.
