voyagerphoen
01-03-2019, 12:36 AM
This is a repost of excel vba permission denied as i reported to delete that post.I found this code in tutorial in youtube .This code should create folder named vbscripting in documents folder and copy all excel files from documents into it but it pops up error message run time error 70 permission denied.It works fine when i change address to D: drive or any other ,But it seems to not working in documents folder.I have checked the permission of that folder and even files in it but no. I have also tried to run excel in compatibility mode, please help.
Dim newfolderpath As StringDim fso As Scripting.FileSystemObject
Sub usingthescriptingruntimelibrary3()
Dim oldfolderpath As String
newfolderpath = Environ("userprofile") & "\Documents\vbscripting"
oldfolderpath = Environ("Userprofile") & "\Documents"
Set fso = New Scripting.FileSystemObject
If fso.FolderExists(oldfolderpath) Then
If Not fso.FolderExists(newfolderpath) Then
fso.createfolder newfolderpath
End If
Call copyexcelfiles(oldfolderpath)
End If
Set fso = Nothing
End Sub
Sub copyexcelfiles(StartFolderPath As String)
Dim oldfolder As Scripting.Folder
Dim subfol As Scripting.Folder
Dim fil As Scripting.File
Set oldfolder = fso.GetFolder(StartFolderPath)
For Each fil In oldfolder.Files
If Left(fso.GetExtensionName(fil.Path), 2) = "xl" Then
fil.Copy newfolderpath & "\" & fil.Name
End If
Next fil
For Each subfol In oldfolder.SubFolders
Call copyexcelfiles(subfol.Path)
Next subfol
End Sub
Dim newfolderpath As StringDim fso As Scripting.FileSystemObject
Sub usingthescriptingruntimelibrary3()
Dim oldfolderpath As String
newfolderpath = Environ("userprofile") & "\Documents\vbscripting"
oldfolderpath = Environ("Userprofile") & "\Documents"
Set fso = New Scripting.FileSystemObject
If fso.FolderExists(oldfolderpath) Then
If Not fso.FolderExists(newfolderpath) Then
fso.createfolder newfolderpath
End If
Call copyexcelfiles(oldfolderpath)
End If
Set fso = Nothing
End Sub
Sub copyexcelfiles(StartFolderPath As String)
Dim oldfolder As Scripting.Folder
Dim subfol As Scripting.Folder
Dim fil As Scripting.File
Set oldfolder = fso.GetFolder(StartFolderPath)
For Each fil In oldfolder.Files
If Left(fso.GetExtensionName(fil.Path), 2) = "xl" Then
fil.Copy newfolderpath & "\" & fil.Name
End If
Next fil
For Each subfol In oldfolder.SubFolders
Call copyexcelfiles(subfol.Path)
Next subfol
End Sub