How do I get around a Run-time error 70 "Permission Denied" when I try to run a fso.copy(filedest) or fso.MoveFile
file, destpath command (where fso is equal to a valid file name). Here is the actual code (I'm a newbie so be gentle)..
Public LogTemp As Object
Public fso As Object
Public TempFolder As String
Public PermFolder As String
'
Sub Main()
Set FSys = CreateObject("Scripting.FileSystemObject"
Today = Month(Date) & "-" & Day(Date) & "-" & Year(Date)
Set LogTemp = FSys.CreateTextFile("C:\Print_XFER\" & Today & "_log.txt", True)
LogTemp.writeline ("Files transfered " & Date)
LogTemp.writeline
TempFolder = "F:\PDF_TEMP\"
PermFolder = "F:\PDF\"
FolderName = TempFolder
RecurseFolderList (FolderName)
End Sub
'
Public Function RecurseFolderList(FolderName As String) _
As Boolean
On Error Resume Next
Dim fso, f, fc, fj, f1
Dim SubFolderName As String
Set fso = CreateObject("Scripting.FileSystemObject"
'
If Err.Number > 0 Then
RecurseFolderList = False
Exit Function
End If
'
On Error GoTo 0
If fso.FolderExists(FolderName) Then
Set f = fso.GetFolder(FolderName)
Set fc = f.Subfolders
Set fj = f.Files
'For each subfolder in the Folder
For Each f1 In fc
'Do something with the Folder Name
' Debug.Print f1
'Fpath = f1.Path
LogTemp.writeline
LogTemp.writeline (f1.Name)
'
RecurseFolderList (f1)
Next
'For each folder check for any files
For Each f1 In fj
LogTemp.writeline (f1)
LogTemp.writeline (FolderName)
' Set path for permanent storage of file
permpath = Replace(FolderName, TempFolder, PermFolder, , , vbTextCompare)
LogTemp.writeline (permpath)
LogTemp.writeline (permpath & "\" & f1.Name)
' Copy file to permanent storage location
If fso.FolderExists(permpath) Then
f1.Copy (permpath)
Else
LogTemp.writeline (permpath & ": Does not Exsist! Creating new folder!"
fso.CreateFolder permpath
If fso.FolderExists(permpath) Then
fso.MoveFile f1, permpath
Else
LogTemp.writeline ("ERROR! " & permpath & "Could not be created! " & f1 & " not moved!"
End If
End If
Next
'
Set f = Nothing
Set fc = Nothing
Set fj = Nothing
Set f1 = Nothing
'
Else
RecurseFolderList = False
End If
'
Set fso = Nothing
'
End Function
file, destpath command (where fso is equal to a valid file name). Here is the actual code (I'm a newbie so be gentle)..
Public LogTemp As Object
Public fso As Object
Public TempFolder As String
Public PermFolder As String
'
Sub Main()
Set FSys = CreateObject("Scripting.FileSystemObject"
Today = Month(Date) & "-" & Day(Date) & "-" & Year(Date)
Set LogTemp = FSys.CreateTextFile("C:\Print_XFER\" & Today & "_log.txt", True)
LogTemp.writeline ("Files transfered " & Date)
LogTemp.writeline
TempFolder = "F:\PDF_TEMP\"
PermFolder = "F:\PDF\"
FolderName = TempFolder
RecurseFolderList (FolderName)
End Sub
'
Public Function RecurseFolderList(FolderName As String) _
As Boolean
On Error Resume Next
Dim fso, f, fc, fj, f1
Dim SubFolderName As String
Set fso = CreateObject("Scripting.FileSystemObject"
'
If Err.Number > 0 Then
RecurseFolderList = False
Exit Function
End If
'
On Error GoTo 0
If fso.FolderExists(FolderName) Then
Set f = fso.GetFolder(FolderName)
Set fc = f.Subfolders
Set fj = f.Files
'For each subfolder in the Folder
For Each f1 In fc
'Do something with the Folder Name
' Debug.Print f1
'Fpath = f1.Path
LogTemp.writeline
LogTemp.writeline (f1.Name)
'
RecurseFolderList (f1)
Next
'For each folder check for any files
For Each f1 In fj
LogTemp.writeline (f1)
LogTemp.writeline (FolderName)
' Set path for permanent storage of file
permpath = Replace(FolderName, TempFolder, PermFolder, , , vbTextCompare)
LogTemp.writeline (permpath)
LogTemp.writeline (permpath & "\" & f1.Name)
' Copy file to permanent storage location
If fso.FolderExists(permpath) Then
f1.Copy (permpath)
Else
LogTemp.writeline (permpath & ": Does not Exsist! Creating new folder!"
fso.CreateFolder permpath
If fso.FolderExists(permpath) Then
fso.MoveFile f1, permpath
Else
LogTemp.writeline ("ERROR! " & permpath & "Could not be created! " & f1 & " not moved!"
End If
End If
Next
'
Set f = Nothing
Set fc = Nothing
Set fj = Nothing
Set f1 = Nothing
'
Else
RecurseFolderList = False
End If
'
Set fso = Nothing
'
End Function