Lrn2Code
Registered User.
- Local time
- Today, 12:55
- Joined
- Dec 8, 2008
- Messages
- 56
Hello Folks!
I'm having a difficult time figuring out what's happening with code to unzip files from a zipped folder. The code worked a month ago (unzipped the files, put them in the FilesforDOE folder AND the data was imported into the backend database) and now it doesn't do any of that!
I don't know what happened and I am getting a very strange error. When I run the import to get the files unzipped then loaded into the backend of the database I get a "The File Exists" error for each file as I try to loop through the code in debug mode. This is not true as the file is NOT in the FilesforDOE folder where the unzipped items are to be copied.
I'm pasting the entire sub below and the line causing an error is highlighted in red.
Any guidance you can provide would be greatly appreciated. I just can't understand why this code worked before and doesn't now.
Thank you very much for your time!
Private Sub cmdImport_Click()
''On Error GoTo err_cmdImport_Click
Dim strRawFileDirectory As String
'strRawFileDirectory = "C:\Stat\FY09\ToImport\"
'THIS IS LISTED BELOW 7-17-09
'TO UNZIP FOLDER SO FILES CAN BE IMPORTED 6-9-09
'cFileZip = "C:\temp\D401001F.ZIP"
'cDestination = "c:\temp\"
Dim cFileZip, cDestination
Dim o, ofile
cFileZip = "C:\Stat\FY09\ToImport\FilesforDOE.Zip"
cDestination = "C:\Stat\FY09\ToImport\FilesforDOE\"
'cDestination = cDestination + "\" + "FilesforDOE\"
Set o = CreateObject("shell.application")
For Each ofile In o.Namespace(cFileZip).items
'o.Namespace(cDestination).copyhere(ofile).items
o.Namespace(cDestination).copyhere (ofile)
Next
'END OF TO UNZIP FOLDER SO FILES CAN BE IMPORTED 6-9-09
'strRawFileDirectory = "T:\DATA\Stat\FY2009\ToImport\"
strRawFileDirectory = "C:\Stat\FY09\ToImport\FilesforDOE\"
'ADDED FilesforDOE AT END OF strRawFileDirectory 6-9-09
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rstCheck As DAO.Recordset
Dim sql As String
Dim sql2 As String
Dim strOrg As String
Dim strFile As String
Dim Orgid As String
Dim strDate As String
Dim strOrigFile As String
Dim strCopyFile As String
Dim x As Integer
Dim fileNames(15) As String
fileNames(0) = "D_Contacts"
fileNames(1) = "D_Expenditures"
fileNames(2) = "D_Revenues"
fileNames(3) = "D_Stat_Edits"
fileNames(4) = "D_SW1"
fileNames(5) = "D_SW2"
fileNames(6) = "D_SW3"
fileNames(7) = "D_SW4"
fileNames(8) = "D_SW5"
fileNames(9) = "D_SW6"
fileNames(10) = "D_SW7"
fileNames(11) = "D_SW8"
fileNames(12) = "D_SW9"
fileNames(13) = "Tbl_Recap_DataEntry"
fileNames(14) = "Util_Opened_Exps"
fileNames(15) = "Util_Opened_Revs"
Set db = CurrentDb
Do Until Dir(strRawFileDirectory) = ""
'delete records in shell tables
x = 0
Do While x < 16
sql = "delete * from Imp" & fileNames(x)
db.Execute (sql)
x = x + 1
Loop
''get an orgid
strFile = Dir(strRawFileDirectory & "*" & ".xls")
strOrg = Left(strFile, 1)
Select Case strOrg
Case "J", "T"
strOrg = Left(strFile, 4)
Case "S", "S", "V"
strOrg = Left(strFile, 5)
Case "U"
strOrg = Left(strFile, 4)
If strOrg = "U022" Then strOrg = Left(strFile, 5)
Case Else
MsgBox ("There is a file with an invalid Org prefix -" & strOrg & "- in the import directory. Import will not continue.")
End Select
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Contacts", strRawFileDirectory & strOrg & "d_contacts.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Expenditures", strRawFileDirectory & strOrg & "d_expenditures.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Revenues", strRawFileDirectory & strOrg & "d_revenues.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Stat_Edits", strRawFileDirectory & strOrg & "d_stat_edits.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW1", strRawFileDirectory & strOrg & "D_SW1.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW2", strRawFileDirectory & strOrg & "D_SW2.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW3", strRawFileDirectory & strOrg & "D_SW3.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW4", strRawFileDirectory & strOrg & "D_SW4.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW5", strRawFileDirectory & strOrg & "D_SW5.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW6", strRawFileDirectory & strOrg & "D_SW6.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW7", strRawFileDirectory & strOrg & "D_SW7.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW8", strRawFileDirectory & strOrg & "D_SW8.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW9", strRawFileDirectory & strOrg & "D_SW9.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpTbl_Recap_DataEntry", strRawFileDirectory & strOrg & "tbl_recap_dataentry.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpUtil_Opened_Exps", strRawFileDirectory & strOrg & "util_opened_exps.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpUtil_Opened_Revs", strRawFileDirectory & strOrg & "util_opened_revs.xls", True
Slowdown
'''clear big tables if org previously loaded
sql = "select MostRecentImport from c_orgs where orgid = '" & strOrg & "'"
Set rs = db.OpenRecordset(sql)
If IsNull(rs.Fields("mostRecentImport")) = False Or rs.Fields("mostRecentImport") = "" Then
x = 0
Do While x < 16
sql2 = "delete * from " & fileNames(x) & " where orgid = '" & strOrg & "'"
db.Execute (sql2)
x = x + 1
Loop
Else
''MkDir "C:\Stat\FY09\Loaded\" & strOrg
'MkDir "T:\DATA\Stat\FY2009\Loaded\" & strOrg
End If
'''move data into big tables
x = 0
Do While x < 16
sql = "insert into " & fileNames(x) & " select * from Imp" & fileNames(x)
db.Execute (sql)
x = x + 1
Loop
'''enter current time/date into c_org table
strDate = Now()
'sql = "update c_orgs set MostRecentImport ='" & strDate & "' where orgid = '" & strOrg & "'"
sql = "update c_orgs set MostRecentImport ='" & strDate & "' , AlreadySetup = Yes where orgid = '" & strOrg & "'"
db.Execute (sql)
'''all has been entered, time/date stamp xls files and move into storage
strDate = Now()
strDate = Replace(strDate, " ", "_")
strDate = Replace(strDate, "/", "_")
strDate = Replace(strDate, ":", "_")
x = 0
Do While x < 16
' strOrigFile = "T:\DATA\Stat\FY2009\ToImport\" & strOrg & fileNames(x) & ".xls"
' strCopyFile = "T:\DATA\Stat\FY2009\Loaded\" & strOrg & "\" & fileNames(x)
strOrigFile = "C:\Stat\FY09\ToImport\" & strOrg & fileNames(x) & ".xls"
strCopyFile = "C:\Stat\FY09\Loaded\" & strOrg & "\" & fileNames(x)
strCopyFile = strCopyFile & strDate
strCopyFile = strCopyFile & ".xls"
FileCopy strOrigFile, strCopyFile
x = x + 1
Loop
'''delete files from loading queue
' Kill "T:\DATA\Stat\FY2009\ToImport\" & strOrg & "*.xls"
Kill "C:\Stat\FY09\ToImport\" & strOrg & "*.xls"
Loop
MsgBox ("No files remain in the ToImport file - this round is complete.")
Exit Sub
err_cmdImport_Click:
Select Case Err.Number
Case 3011
MsgBox ("The " & strOrg & "org is missing a file or has a misnamed file. Please remove this district's files from the ToImport directory before running this import.")
Exit Sub
Case Else
MsgBox ("You found error " & Err.Number)
Exit Sub
End Select
End Sub
I'm having a difficult time figuring out what's happening with code to unzip files from a zipped folder. The code worked a month ago (unzipped the files, put them in the FilesforDOE folder AND the data was imported into the backend database) and now it doesn't do any of that!
I don't know what happened and I am getting a very strange error. When I run the import to get the files unzipped then loaded into the backend of the database I get a "The File Exists" error for each file as I try to loop through the code in debug mode. This is not true as the file is NOT in the FilesforDOE folder where the unzipped items are to be copied.
I'm pasting the entire sub below and the line causing an error is highlighted in red.
Any guidance you can provide would be greatly appreciated. I just can't understand why this code worked before and doesn't now.
Thank you very much for your time!
Private Sub cmdImport_Click()
''On Error GoTo err_cmdImport_Click
Dim strRawFileDirectory As String
'strRawFileDirectory = "C:\Stat\FY09\ToImport\"
'THIS IS LISTED BELOW 7-17-09
'TO UNZIP FOLDER SO FILES CAN BE IMPORTED 6-9-09
'cFileZip = "C:\temp\D401001F.ZIP"
'cDestination = "c:\temp\"
Dim cFileZip, cDestination
Dim o, ofile
cFileZip = "C:\Stat\FY09\ToImport\FilesforDOE.Zip"
cDestination = "C:\Stat\FY09\ToImport\FilesforDOE\"
'cDestination = cDestination + "\" + "FilesforDOE\"
Set o = CreateObject("shell.application")
For Each ofile In o.Namespace(cFileZip).items
'o.Namespace(cDestination).copyhere(ofile).items
o.Namespace(cDestination).copyhere (ofile)
Next
'END OF TO UNZIP FOLDER SO FILES CAN BE IMPORTED 6-9-09
'strRawFileDirectory = "T:\DATA\Stat\FY2009\ToImport\"
strRawFileDirectory = "C:\Stat\FY09\ToImport\FilesforDOE\"
'ADDED FilesforDOE AT END OF strRawFileDirectory 6-9-09
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rstCheck As DAO.Recordset
Dim sql As String
Dim sql2 As String
Dim strOrg As String
Dim strFile As String
Dim Orgid As String
Dim strDate As String
Dim strOrigFile As String
Dim strCopyFile As String
Dim x As Integer
Dim fileNames(15) As String
fileNames(0) = "D_Contacts"
fileNames(1) = "D_Expenditures"
fileNames(2) = "D_Revenues"
fileNames(3) = "D_Stat_Edits"
fileNames(4) = "D_SW1"
fileNames(5) = "D_SW2"
fileNames(6) = "D_SW3"
fileNames(7) = "D_SW4"
fileNames(8) = "D_SW5"
fileNames(9) = "D_SW6"
fileNames(10) = "D_SW7"
fileNames(11) = "D_SW8"
fileNames(12) = "D_SW9"
fileNames(13) = "Tbl_Recap_DataEntry"
fileNames(14) = "Util_Opened_Exps"
fileNames(15) = "Util_Opened_Revs"
Set db = CurrentDb
Do Until Dir(strRawFileDirectory) = ""
'delete records in shell tables
x = 0
Do While x < 16
sql = "delete * from Imp" & fileNames(x)
db.Execute (sql)
x = x + 1
Loop
''get an orgid
strFile = Dir(strRawFileDirectory & "*" & ".xls")
strOrg = Left(strFile, 1)
Select Case strOrg
Case "J", "T"
strOrg = Left(strFile, 4)
Case "S", "S", "V"
strOrg = Left(strFile, 5)
Case "U"
strOrg = Left(strFile, 4)
If strOrg = "U022" Then strOrg = Left(strFile, 5)
Case Else
MsgBox ("There is a file with an invalid Org prefix -" & strOrg & "- in the import directory. Import will not continue.")
End Select
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Contacts", strRawFileDirectory & strOrg & "d_contacts.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Expenditures", strRawFileDirectory & strOrg & "d_expenditures.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Revenues", strRawFileDirectory & strOrg & "d_revenues.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_Stat_Edits", strRawFileDirectory & strOrg & "d_stat_edits.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW1", strRawFileDirectory & strOrg & "D_SW1.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW2", strRawFileDirectory & strOrg & "D_SW2.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW3", strRawFileDirectory & strOrg & "D_SW3.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW4", strRawFileDirectory & strOrg & "D_SW4.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW5", strRawFileDirectory & strOrg & "D_SW5.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW6", strRawFileDirectory & strOrg & "D_SW6.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW7", strRawFileDirectory & strOrg & "D_SW7.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW8", strRawFileDirectory & strOrg & "D_SW8.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpD_SW9", strRawFileDirectory & strOrg & "D_SW9.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpTbl_Recap_DataEntry", strRawFileDirectory & strOrg & "tbl_recap_dataentry.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpUtil_Opened_Exps", strRawFileDirectory & strOrg & "util_opened_exps.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImpUtil_Opened_Revs", strRawFileDirectory & strOrg & "util_opened_revs.xls", True
Slowdown
'''clear big tables if org previously loaded
sql = "select MostRecentImport from c_orgs where orgid = '" & strOrg & "'"
Set rs = db.OpenRecordset(sql)
If IsNull(rs.Fields("mostRecentImport")) = False Or rs.Fields("mostRecentImport") = "" Then
x = 0
Do While x < 16
sql2 = "delete * from " & fileNames(x) & " where orgid = '" & strOrg & "'"
db.Execute (sql2)
x = x + 1
Loop
Else
''MkDir "C:\Stat\FY09\Loaded\" & strOrg
'MkDir "T:\DATA\Stat\FY2009\Loaded\" & strOrg
End If
'''move data into big tables
x = 0
Do While x < 16
sql = "insert into " & fileNames(x) & " select * from Imp" & fileNames(x)
db.Execute (sql)
x = x + 1
Loop
'''enter current time/date into c_org table
strDate = Now()
'sql = "update c_orgs set MostRecentImport ='" & strDate & "' where orgid = '" & strOrg & "'"
sql = "update c_orgs set MostRecentImport ='" & strDate & "' , AlreadySetup = Yes where orgid = '" & strOrg & "'"
db.Execute (sql)
'''all has been entered, time/date stamp xls files and move into storage
strDate = Now()
strDate = Replace(strDate, " ", "_")
strDate = Replace(strDate, "/", "_")
strDate = Replace(strDate, ":", "_")
x = 0
Do While x < 16
' strOrigFile = "T:\DATA\Stat\FY2009\ToImport\" & strOrg & fileNames(x) & ".xls"
' strCopyFile = "T:\DATA\Stat\FY2009\Loaded\" & strOrg & "\" & fileNames(x)
strOrigFile = "C:\Stat\FY09\ToImport\" & strOrg & fileNames(x) & ".xls"
strCopyFile = "C:\Stat\FY09\Loaded\" & strOrg & "\" & fileNames(x)
strCopyFile = strCopyFile & strDate
strCopyFile = strCopyFile & ".xls"
FileCopy strOrigFile, strCopyFile
x = x + 1
Loop
'''delete files from loading queue
' Kill "T:\DATA\Stat\FY2009\ToImport\" & strOrg & "*.xls"
Kill "C:\Stat\FY09\ToImport\" & strOrg & "*.xls"
Loop
MsgBox ("No files remain in the ToImport file - this round is complete.")
Exit Sub
err_cmdImport_Click:
Select Case Err.Number
Case 3011
MsgBox ("The " & strOrg & "org is missing a file or has a misnamed file. Please remove this district's files from the ToImport directory before running this import.")
Exit Sub
Case Else
MsgBox ("You found error " & Err.Number)
Exit Sub
End Select
End Sub