hello all,
I am stumped. I have the following code. I am trying to import only worksheets named "AGT" or "CORP" in 1 excel workbook. I am getting a data type mismatch error 13 when trying to get the worksheet name. Please see the code below.
Private Sub cmdSplit_Click()
'Make sure user selected an import file during browse mode
txtImportFile.SetFocus
If txtImportFile.Text <> "" Then
'Declare for importing tables
Dim ShtName As String
Dim objSrc As Object
Dim X As Long
Dim tblName As String
'Declare for splitting files
Dim dbs As DAO.Database
Dim rstStates, rstOutput As DAO.Recordset
Dim FileHandle As Integer
Set dbs = CurrentDb()
'Assuming a form with textbox for import filename named Me![txtImportFile].
'Assuming you can set to your import file (see other posts).
Set objSrc = GetObject(Me![txtImportFile])
For X = 1 To objSrc.Sheets.Count
ShtName = objSrc.Sheets(X).Name
'You may have to tweak this if you don't want to import entire sheet.
'Also, space in tabnames can cause problems.
'AGT OR CORP only
'Import AGT and CORP worksheets only into tables***********************************************************
If ShtName = "AGT" Or "CORP" Then
tblName = "tblImportTo" & ShtName
DoCmd.TransferSpreadsheet acImport, , tblName, Me![txtImportFile], True, ShtName & "!"
'Split files*********************************************************************************************
Set rstStates = dbs.OpenRecordset("SELECT DISTINCT ST FROM " & tblName & ";", dbOpenDynaset)
'Empty Listbox on main form
lstFiles.SetFocus
For i = 0 To lstFiles.ListCount - 1
If i > lstFiles.ListCount - 1 Then
lstFiles.RemoveItem (i)
lstFiles.Requery
End If
Next i
'Create folder for CSV files
strPath = Dir("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"), vbDirectory)
If strPath <> "" Then
' It Exists
'RmDir ("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"))
'MkDir ("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"))
strPath = "L:\finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd") & "\"
Else
' Does not Exist
MkDir ("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"))
strPath = "L:\finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd") & "\"
End If
'Split files
Do Until rstStates.EOF
If rstStates![ST] <> "" Then
FileHandle = FreeFile
Open strPath & Format(Date, "yyyymmdd") & "_" & ShtName & "_" & rstStates![ST] & ".csv" For Output As #FileHandle
Set rstOutput = dbs.OpenRecordset("SELECT * FROM " & tblName & " WHERE ST = '" & rstStates![ST] & "';", dbOpenDynaset)
If ShtName = "CORP" Then
Do Until rstOutput.EOF
Write #FileHandle, rstOutput![SSN], rstOutput![Name]
rstOutput.MoveNext
Loop
lstFiles.AddItem strPath & Format(Date, "yyyymmdd") & "_" & ShtName & "_" & rstStates![ST] & ".csv"
End If
If ShtName = "AGT" Then
Do Until rstOutput.EOF
Write #FileHandle, rstOutput![SSN], rstOutput![LASTNAME]
rstOutput.MoveNext
Loop
'Add file path to listbox on main form
lstFiles.AddItem strPath & Format(Date, "yyyymmdd") & "_" & ShtName & "_" & rstStates![ST] & ".csv"
End If
Close #FileHandle
End If
rstStates.MoveNext
Loop
End If
Next X
Else
'Error Message to User
MsgBox "You must browse for an import file.", vbCritical, "Error..."
End If
End Sub
*******************************************
This is where the error is:
If ShtName = "AGT" Or "CORP" Then
tblName = "tblImportTo" & ShtName
DoCmd.TransferSpreadsheet acImport, , tblName, Me![txtImportFile], True, ShtName & "!"
*********************************************
I declared ShtName as a string. Is there something wrong with Excel where the name of a worksheet is not a string value?
Please help, Thanks
Mike
I am stumped. I have the following code. I am trying to import only worksheets named "AGT" or "CORP" in 1 excel workbook. I am getting a data type mismatch error 13 when trying to get the worksheet name. Please see the code below.
Private Sub cmdSplit_Click()
'Make sure user selected an import file during browse mode
txtImportFile.SetFocus
If txtImportFile.Text <> "" Then
'Declare for importing tables
Dim ShtName As String
Dim objSrc As Object
Dim X As Long
Dim tblName As String
'Declare for splitting files
Dim dbs As DAO.Database
Dim rstStates, rstOutput As DAO.Recordset
Dim FileHandle As Integer
Set dbs = CurrentDb()
'Assuming a form with textbox for import filename named Me![txtImportFile].
'Assuming you can set to your import file (see other posts).
Set objSrc = GetObject(Me![txtImportFile])
For X = 1 To objSrc.Sheets.Count
ShtName = objSrc.Sheets(X).Name
'You may have to tweak this if you don't want to import entire sheet.
'Also, space in tabnames can cause problems.
'AGT OR CORP only
'Import AGT and CORP worksheets only into tables***********************************************************
If ShtName = "AGT" Or "CORP" Then
tblName = "tblImportTo" & ShtName
DoCmd.TransferSpreadsheet acImport, , tblName, Me![txtImportFile], True, ShtName & "!"
'Split files*********************************************************************************************
Set rstStates = dbs.OpenRecordset("SELECT DISTINCT ST FROM " & tblName & ";", dbOpenDynaset)
'Empty Listbox on main form
lstFiles.SetFocus
For i = 0 To lstFiles.ListCount - 1
If i > lstFiles.ListCount - 1 Then
lstFiles.RemoveItem (i)
lstFiles.Requery
End If
Next i
'Create folder for CSV files
strPath = Dir("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"), vbDirectory)
If strPath <> "" Then
' It Exists
'RmDir ("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"))
'MkDir ("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"))
strPath = "L:\finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd") & "\"
Else
' Does not Exist
MkDir ("L:\Finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd"))
strPath = "L:\finance\AMAccessApplications\ExpiredLicUpload\SplitOLQ\" & Format(Date, "yyyymmdd") & "\"
End If
'Split files
Do Until rstStates.EOF
If rstStates![ST] <> "" Then
FileHandle = FreeFile
Open strPath & Format(Date, "yyyymmdd") & "_" & ShtName & "_" & rstStates![ST] & ".csv" For Output As #FileHandle
Set rstOutput = dbs.OpenRecordset("SELECT * FROM " & tblName & " WHERE ST = '" & rstStates![ST] & "';", dbOpenDynaset)
If ShtName = "CORP" Then
Do Until rstOutput.EOF
Write #FileHandle, rstOutput![SSN], rstOutput![Name]
rstOutput.MoveNext
Loop
lstFiles.AddItem strPath & Format(Date, "yyyymmdd") & "_" & ShtName & "_" & rstStates![ST] & ".csv"
End If
If ShtName = "AGT" Then
Do Until rstOutput.EOF
Write #FileHandle, rstOutput![SSN], rstOutput![LASTNAME]
rstOutput.MoveNext
Loop
'Add file path to listbox on main form
lstFiles.AddItem strPath & Format(Date, "yyyymmdd") & "_" & ShtName & "_" & rstStates![ST] & ".csv"
End If
Close #FileHandle
End If
rstStates.MoveNext
Loop
End If
Next X
Else
'Error Message to User
MsgBox "You must browse for an import file.", vbCritical, "Error..."
End If
End Sub
*******************************************
This is where the error is:
If ShtName = "AGT" Or "CORP" Then
tblName = "tblImportTo" & ShtName
DoCmd.TransferSpreadsheet acImport, , tblName, Me![txtImportFile], True, ShtName & "!"
*********************************************
I declared ShtName as a string. Is there something wrong with Excel where the name of a worksheet is not a string value?
Please help, Thanks
Mike