Unzip Folder Problems

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
 
Usually when this occurs it implies that something has changed with the environment of the pc/laptop/server. Has anything changed? such as OS, Access version, new software, etc.

Will it run on another machine or is it just one?

It's mearly a case of process and elimination.

David
 
At this time it seems to be my laptop only getting that error. I did run a Windows update earlier this week. GREAT - I probably messed something up.

Will see if I can figure out what may have caused this. Thanks for your reply and have a great day!
 
Still not having any luck getting rid of that error. Did notice that my Access Service Pack number hasn't changed so not sure what else may be causing the issue. Am going to check with a coworker to find out what the library references are on his laptop as that may hold the key.

If anyone has any other ideas please feel free to post them...I'm really stuck. :confused: :confused: :confused:

Thanks! :)
 
Now the "The File Exists" error seems to have gone and I'm getting a

"run time error 91 object variable or with block variable not set"

at that same line of code - excerpt follows -

Dim cFileZip As Variant
Dim cDestination As String
Dim o As Object
Dim ofile As Object
Dim Namespace As Variant
Set Namespace = Nothing
Set ofile = Nothing



cFileZip = "C:\Stat\FY09\ToImport\FilesforDOE.Zip"
cDestination = "C:\Stat\FY09\ToImport\FilesforDOE\"

Set db = CurrentDb


Set o = CreateObject("shell.application")
For Each ofile In o.Namespace(cFileZip).items

o.Namespace(cDestination).copyhere(ofile).items
Next

I keep thinking it's got something to do with Namespace but Web searching hasn't turned up anything that helps.

Any ideas?


Thanks and have a great weekend!
 

Users who are viewing this thread

Back
Top Bottom