L
Lee T.
We get spreadsheets from a vendor a couple times a week.
I set up a system (with the help of folks here) that
allows me to import them.
However, the sheets occasionally come in messed up. I
would like to have a way to edit the EXCEL file and then
upon exiting have it continue processing. Right now it
works okay but I get the following message sometime after
I saved the file and have finished the access processing:
File Now Available
'asdfasdf.xls' Is now available for editing.
Choose Read-Write to open it for editing.
I really don't understand why this is popping up.
Actually I would prefer to read the spreadsheet and skip
down until I find the cell I want. So if A1 is not SID
then check for a2 and so on until i find it or until I
have tried 20 lines. However I don't know if that can be
done so I tried this instead...
Here is the code I am using:
******************Code Start*******************
Dim objXL As Excel.Application
Dim objWB As Excel.Workbook
Dim strFN As String
Dim strFullFileName As String 'The File
Path Name
Dim strExt As String 'File
Extention
Dim strFileName As String 'File
Name without the extention
Dim strSQL As String 'SQL for
the append
Again:
Me.CommonDialog7.ShowOpen 'Open the
Windows Dialog Box
strFullFileName = Me.CommonDialog7.FileName 'Get the
FileName to use in the system
' Check the file name, if doesn't exits exit
If IsNull(strFullFileName) Or (strFullFileName = "")
Then
GoTo bail:
End If
' Get the file name and extention and make sure it is
an EXCEL file type.
' If not Excel, pop open the Windows Dialog box for
file input
adhSplitPath strFullFileName, , , strFileName, strExt
If strExt <> (".xls") Then
MsgBox ("Please Select an EXCEL
Document"), , "Invalid File Type"
GoTo Again: ' Bring up the Windows
Dialog box again for them
End If
' If the file type is XL, then split out the filename
' It must begin with "Dirtbag*" or "SHARKS"
If Left(strFileName, 6) = "Dirtbag" Or Left
(strFileName, 6) = "SHARKS" Then
Me.zFileName =
strFullFileName 'Display the name in the form
strFN = Me.zFileName
Set objXL = New Excel.Application
Set objWB = objXL.Workbooks.Open(strFN)
objXL.Visible = True
Set objXL = Nothing
Set objWB = Nothing
'Insert the filename into the system for tracking.
Me.zFileStore = strFileName & strExt
strSQL = "INSERT INTO tbl_BadPeoplefilename
(FileName) " & _
"Values (""" & strFileName & """);"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
' Loop through and delete any import errors as well
as the "main" table
DoCmd.SetWarnings False
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
If obj.FullName = "Main" Then
DoCmd.DeleteObject acTable, "Main"
End If
If obj.FullName = "Sheet1$_ImportErrors" Then
DoCmd.DeleteObject acTable, "Sheet1
$_ImportErrors"
End If
If obj.FullName = "Sheet1$_ImportErrors1" Then
DoCmd.DeleteObject acTable, "Sheet1
$_ImportErrors1"
End If
If obj.FullName = "Sheet1$_ImportErrors2" Then
DoCmd.DeleteObject acTable, "Sheet1
$_ImportErrors2"
End If
Next obj
DoCmd.SetWarnings True
DoCmd.TransferSpreadsheet acImport,
acSpreadsheetTypeExcel9, "Main", strFullFileName,
True, "sheet1!a1:IV65536"
Else
' If the first 6 chars are not "DIRTBAG"
or "SHARKS" then
' pop this message box and have the user start again
MsgBox ("Please Select a DIRTBAG or SHARKS
File"), , "Incorrect FileName"
GoTo Again:
End If
DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_MT_getLastName", acViewNormal,
acEdit
DoCmd.OpenQuery "qry_AT_getLastNameSuffix",
acViewNormal, acEdit
DoCmd.SetWarnings True
If Left(strFileName, 6) = "Dirtbag" Then
DoCmd.OpenForm "frm_Dirtbag"
Else
DoCmd.OpenForm "frm_SHARKS"
End If
******************Code END*********************
I set up a system (with the help of folks here) that
allows me to import them.
However, the sheets occasionally come in messed up. I
would like to have a way to edit the EXCEL file and then
upon exiting have it continue processing. Right now it
works okay but I get the following message sometime after
I saved the file and have finished the access processing:
File Now Available
'asdfasdf.xls' Is now available for editing.
Choose Read-Write to open it for editing.
I really don't understand why this is popping up.
Actually I would prefer to read the spreadsheet and skip
down until I find the cell I want. So if A1 is not SID
then check for a2 and so on until i find it or until I
have tried 20 lines. However I don't know if that can be
done so I tried this instead...
Here is the code I am using:
******************Code Start*******************
Dim objXL As Excel.Application
Dim objWB As Excel.Workbook
Dim strFN As String
Dim strFullFileName As String 'The File
Path Name
Dim strExt As String 'File
Extention
Dim strFileName As String 'File
Name without the extention
Dim strSQL As String 'SQL for
the append
Again:
Me.CommonDialog7.ShowOpen 'Open the
Windows Dialog Box
strFullFileName = Me.CommonDialog7.FileName 'Get the
FileName to use in the system
' Check the file name, if doesn't exits exit
If IsNull(strFullFileName) Or (strFullFileName = "")
Then
GoTo bail:
End If
' Get the file name and extention and make sure it is
an EXCEL file type.
' If not Excel, pop open the Windows Dialog box for
file input
adhSplitPath strFullFileName, , , strFileName, strExt
If strExt <> (".xls") Then
MsgBox ("Please Select an EXCEL
Document"), , "Invalid File Type"
GoTo Again: ' Bring up the Windows
Dialog box again for them
End If
' If the file type is XL, then split out the filename
' It must begin with "Dirtbag*" or "SHARKS"
If Left(strFileName, 6) = "Dirtbag" Or Left
(strFileName, 6) = "SHARKS" Then
Me.zFileName =
strFullFileName 'Display the name in the form
strFN = Me.zFileName
Set objXL = New Excel.Application
Set objWB = objXL.Workbooks.Open(strFN)
objXL.Visible = True
Set objXL = Nothing
Set objWB = Nothing
'Insert the filename into the system for tracking.
Me.zFileStore = strFileName & strExt
strSQL = "INSERT INTO tbl_BadPeoplefilename
(FileName) " & _
"Values (""" & strFileName & """);"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
' Loop through and delete any import errors as well
as the "main" table
DoCmd.SetWarnings False
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
If obj.FullName = "Main" Then
DoCmd.DeleteObject acTable, "Main"
End If
If obj.FullName = "Sheet1$_ImportErrors" Then
DoCmd.DeleteObject acTable, "Sheet1
$_ImportErrors"
End If
If obj.FullName = "Sheet1$_ImportErrors1" Then
DoCmd.DeleteObject acTable, "Sheet1
$_ImportErrors1"
End If
If obj.FullName = "Sheet1$_ImportErrors2" Then
DoCmd.DeleteObject acTable, "Sheet1
$_ImportErrors2"
End If
Next obj
DoCmd.SetWarnings True
DoCmd.TransferSpreadsheet acImport,
acSpreadsheetTypeExcel9, "Main", strFullFileName,
True, "sheet1!a1:IV65536"
Else
' If the first 6 chars are not "DIRTBAG"
or "SHARKS" then
' pop this message box and have the user start again
MsgBox ("Please Select a DIRTBAG or SHARKS
File"), , "Incorrect FileName"
GoTo Again:
End If
DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_MT_getLastName", acViewNormal,
acEdit
DoCmd.OpenQuery "qry_AT_getLastNameSuffix",
acViewNormal, acEdit
DoCmd.SetWarnings True
If Left(strFileName, 6) = "Dirtbag" Then
DoCmd.OpenForm "frm_Dirtbag"
Else
DoCmd.OpenForm "frm_SHARKS"
End If
******************Code END*********************