fpskidmark
Board Regular
- Joined
- Sep 11, 2009
- Messages
- 139
Hi All,
Can anyone please tell me why I'm getting this Compressed (zipped) Folder Error msg "File not found or no read permission" when I run the code below?
Actually, when I run the code on my PC (Operating system - MS Window XP), it works fine, but when my colleague runs it on his PC (MS Window 7) it doesn't work correctly.
The code is supposed to create a zip file then transfers excel files onto the zip file.
When my colleague runs the code, only a few of the excel files are transfers to the Zip file and then he'll get the Compressed (zipped) Folder Error msg.
Any suggestions?
Thank you,
FP
Can anyone please tell me why I'm getting this Compressed (zipped) Folder Error msg "File not found or no read permission" when I run the code below?
Actually, when I run the code on my PC (Operating system - MS Window XP), it works fine, but when my colleague runs it on his PC (MS Window 7) it doesn't work correctly.
The code is supposed to create a zip file then transfers excel files onto the zip file.
When my colleague runs the code, only a few of the excel files are transfers to the Zip file and then he'll get the Compressed (zipped) Folder Error msg.
Any suggestions?
Code:
Sub NewZip(sPath)
'Create empty Zip File
Dim oFSO, arrHex, sBin, i, Zip
Set oFSO = CreateObject("Scripting.FileSystemObject")
arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(arrHex)
sBin = sBin & Chr(arrHex(i))
Next
With oFSO.CreateTextFile(sPath, True)
.Write sBin
.Close
End With
End Sub
Sub Zip_File()
' Copy files to the Zipped File
Dim oApp As Object
On Error Resume Next
Application.DisplayAlerts = False: Windows("OP Report Grid Trend - " & Sheets("MD").Range("A1") & ".xls").Close
NewZip ("P:\OP ZIP Folder\Op Report - " & Sheets("Rafael").Range("F14") & ".zip")
Set oApp = CreateObject("Shell.Application")
Sheets("MD").Visible = True: Sheets("MD").Select
lastrow = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For z = 1 To lastrow + 2
oApp.Namespace("P:\OP ZIP Folder\Op Report - " & Workbooks("OP Report Grid Trend").Sheets("Rafael").Range("F14") & ".zip").CopyHere ("P:\MD OP Report\OP Report Grid Trend - " & Workbooks("OP Report Grid Trend").Sheets("MD").Range("A" & z) & ".xls")
Next z
On Error Resume Next
Set oApp = Nothing
lastrow = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For k = 1 To lastrow + 2
Kill ("P:\MD OP Report\OP Report Grid Trend - " & Workbooks("OP Report Grid Trend").Sheets("MD").Range("A" & k) & ".xls")
Next k
Sheets("MD").Visible = False
Sheets("Rafael").Select
MsgBox ("ZIPPED FILE CREATED")
End Sub
Thank you,
FP