I am using this code to loop through the files in sharepoint using excel VBA. This code is working fine when I am using the local drive path. But when I replace the path with my sharepoint path, I am getting an error saying 'Path Not Found' at fs.GetFolder
Please kindly advice
Code I am using is:
Private Sub CommandButton2_Click()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim fs1 As New OLEObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
FPath = "my URL"
Set fs = CreateObject("Scripting.FileSystemObject")
RowCtr = 1
Set folder = fs.GetFolder(FPath)
'<=Variable Location
For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
You'll need to map sharepoint to a Windows drive letter, as outlined in SharePoint StackExchange. Once it's mapped you'll be able to open as a local drive path.
Related
Our SharePoint site used to be on-prem, and it migrated to the one hosted on the cloud.
We had the following VBA code to upload a file to its document library, and it stopped working although we have the correct new URL. It doesn't throw any error, but it just doesn't upload the file. Is there another way do upload a file? Thank you very much.
' To read source files as byte
Dim binaryByte() As Byte
Dim binaryByteData As Variant
'Get lngFileLength for binarybyte initialization.
Dim lngFileLength As Long
'Initilizate the scripting object for getting folder information.
Dim objFSO As Scripting.FileSystemObject
Set objFSO = New Scripting.FileSystemObject
' Initialize the xmlhttp object
Dim LobjXML As Object
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
'Set sharepoint URL from tbl_Lookup
sSharePointURL = ELookup("SharePointFolderURLPath", "tbl_Lookup")
'Get path of file to publish
sFilePath = CurrentProject.Path & "\Published"
' Get the filename
sFileNameWithPath = sFilePath & "\" & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")
'Array length identification
lngFileLength = FileLen(sFileNameWithPath) - 1
'Reinitialize the byte array
ReDim binaryByte(lngFileLength)
'Open file binary consumption
Open sFileNameWithPath For Binary As #1
Get #1, , binaryByte
Close #1
' Convert to variant to upload.
binaryByteData = binaryByte
'Destination URL
sDestinationURL = sSharePointURL & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")
' Upload the data to the server, false means synchronous.
LobjXML.Open "PUT", sDestinationURL, False
Set LobjXML = Nothing
Set objFSO = Nothing
I'm trying to copy the PDF files from a mapped remote directory to my local machine using the CopyFolder method. I'm getting a 'permission denied' error, and I believe it may be trying to copy hidden or system files. I'm wanting to preserve the folder structure from the source, and only need the PDFs. Is there a way to do this with CopyFolder, or should I use a shell command like robocopy instead?
Here's my code so far:
Public Sub DownloadFiles(FSOFolder As Object)
Dim MyFSO As FileSystemObject
Set MyFSO = New Scripting.FileSystemObject
Dim FSOSubFolder As Object
Dim FSOFile As Object
MyFSO.CopyFolder FSOFolder.path & "*", "C:\Users\UserName\Desktop\Temp"
'code continues
The folders are created, but it seems to error when it tries to copy the first file. Thanks everyone for your suggestions.
You could try copying the files individually with error handling to ignore files that you don't have permission to copy. You will need to create the folders manually under this approach.
Here is a sample code to show the concept. I did not test it.
Sub CopyFiles()
Dim FSO as FileSystemObject
Dim DestinationFolder as Folder
Dim CopyFolder as Folder
Set FSO = New FileSystemObject
Set DestinationFolder = FSO.GetFolder("Your Path to Copy To")
Set CopyFolder = FSO.GetFolder("Your Path to Copy From")
Call Recurse(CopyFolder, DestinationFolder)
End Sub
Sub Recurse(CopyFolder as Folder, DesintationFolder as Folder)
Dim SubFolder as Folder
Dim File as File
On Error Resume Next
For Each File in CopyFolder.Files
FSO.CopyFile(File.Path, DestinationFolder.Path & "\")
Next File
On Error GoTo 0
For Each SubFolder in CopyFolder.Subfolders
Call Recurse(SubFolder, FSO.CreateFolder(DestinationFolder.Path & "\" & SubFolder.Name))
Next SubFolder
End Sub
Let me know if you have any issues with this.
Here's the VBA code I'm using in MS Access (from Microsoft's support site - no edits):
**
Private Sub Command3_Click()
Dim fso As New FileSystemObject
Dim f As Folder, sf As Folder, path As String
'Initialize path.
path = Environ("windir")
'Get a reference to the Folder object.
Set f = fso.GetFolder(path)
'Iterate through subfolders.
For Each sf In f.SubFolders
Debug.Print sf.Name
Next
End Sub
**
I have also created the directory "C:\Test" and tried path = "C:\Test\" and path = "C:\Test"
I am aware that the reference "Microsoft Scripting Runtime" needs to be enabled - and it is.
The code compiles without error.
Despite the above, I'm still getting Run-time Error '13' Type Mismatch when I try to run it.
Is there anything else I'm doing wrong?
Try late binding
Private Sub Command3_Click()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f As Object, sf As Object, path As String
'Initialize path.
path = Environ("windir")
'Get a reference to the Folder object.
Set f = fso.GetFolder(path)
'Iterate through subfolders.
For Each sf In f.SubFolders
Debug.Print sf.Name
Next
End Sub
I have a folder contain texts files . The text is presented as below :
NAME Number Mail Date
xx 1 zz //
and I want to write a vba code that read all the text files and search for an information "NAME" to replace it with "name"and then save the modifications .
I did the code below , but I have an error 70 permission denied in Set f = FSO.OpenTextFile(Fichier, forWriting, True) ,
could you help me ?
Sub Sample()
dim fso=createobject("scripting.filesystemObject")
dim f
dim path as string
dim file_txt as string
path= "C:\Users\Folder\Fileshere\"
file_txt= Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = FSO.OpenTextFile(file_txt, ForReading)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange , "NAME", "name")
Set f = FSO.OpenTextFile(file_txt, forWriting, True)
f.Write Namechange
file_txt=dir()
loop
end sub
I'd rewrite using a bit more of the FileSystemObject functionality rather than using Dir() personally, but that's open to your own choice. The key issue I think you are having is that you have opened the file for reading and then immediately tried to open it for writing while the TextStream object is still in memory, and locking the file. This is why you are getting "Permission denied". To quote from a TechNet Article:
Opening Text Files
Working with text files is a three-step process.
Before you can do anything else, you must open the text file. This can
be done either by opening an existing file or by creating a new text
file. (When you create a new file, that file is automatically opened
and ready for use.) Either approach returns a reference to the
TextStream object. After you have a reference to the TextStream
object, you can either read from or write to the file. However, you
cannot simultaneously read from and write to the same file. In other
words, you cannot open a file, read the contents, and then write
additional data to the file, all in the same operation. Instead, you
must read the contents, close the file, and then reopen and write the
additional data. When you open an existing text file, the file can be
opened either for reading or for writing. When you create a new text
file, the file is open only for writing, if for no other reason than
that there is no content to read. Finally, you should always close a
text file. Although this is not required (the file will generally be
closed as soon as the script terminates), it is good programming
practice.
My code should work for your requirements. I've removed the While loop from the middle as if you are using ReadAll then you don't need to loop over the text.
Sub MySub()
Dim fso
Set fso = CreateObject("scripting.filesystemObject")
Dim file, folder
Dim path As String
Dim file_txt As String
path = "C:\users\folders\fileshere\"
Set folder = fso.GetFolder(path)
For Each file In folder.Files
Set file = fso.OpenTextFile(file.Path, 1)
Namechange = file.ReadAll
file.Close
Namechange = Replace(Namechange, "NAME", "name")
Set file = fso.OpenTextFile(file.Path, 2, True)
file.Write Namechange
file.Close
Next
End Sub
If you have any difficulties or would like further explanation of the above, let me know.
Some minor changes and it worked for me. Please change the path as per your own requirement in following code:
Sub change_txt()
Dim fso As Object
Set fso = CreateObject("scripting.filesystemObject")
Dim f
Dim path As String
Dim file_txt As String
path = "D:\Folder\Fileshare\"
file_txt = Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = fso.opentextfile(path & file_txt, 1)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange, "NAME", "name")
Set f = fso.opentextfile(path & file_txt, 2)
f.Write Namechange
file_txt = Dir()
Loop
End Sub
Using VBA. My script moves a file into a directory. If that filename already exists in the target directory, I want the user to be prompted to rename the source file (the one that's being moved) before the move is executed.
Because I want the user to know what other files are in the directory already (so they don't choose the name of another file that's already there), my idea is to open a FileDialog box listing the contents of the directory, so that the user can use the FileDialog box's native renaming capability. Then I'll loop that FileDialog until the source file and target file names are no longer the same.
Here's some sample code:
Sub testMoveFile()
Dim fso As FileSystemObject
Dim file1 As File
Dim file2 As File
Dim dialog As FileDialog
Set fso = New FileSystemObject
fso.CreateFolder "c:\dir1"
fso.CreateFolder "c:\dir2"
fso.CreateTextFile "c:\dir1\test.txt"
fso.CreateTextFile "c:\dir2\test.txt"
Set file1 = fso.GetFile("c:\dir1\test.txt")
Set file2 = fso.GetFile("c:\dir2\test.txt")
Set dialog = Application.FileDialog(msoFileDialogOpen)
While file1.Name = file2.Name
dialog.InitialFileName = fso.GetParentFolderName(file2.Path)
If dialog.Show = 0 Then
Exit Sub
End If
Wend
file1.Move "c:\dir2\" & file1.Name
End Sub
But when I rename file2 and click 'OK', I get an error:
Run-time error '53': File not found
and then going into the debugger shows that the value of file2.name is <File not found>.
I'm not sure what's happening here--is the object reference being lost once the file's renamed? Is there an easier way to let the user rename from a dialog that shows all files in the target directory? I'd also like to provide a default new name for the file, but I can't see how I'd do that using this method.
edit: at this point I'm looking into making a UserForm with a listbox that gets populated w/ the relevant filenames, and an input box with a default value for entering the new name. Still not sure how to hold onto the object reference once the file gets renamed, though.
Here's a sample of using Application.FileDialog to return a filename that the user selected. Maybe it will help, as it demonstrates getting the value the user provided.
EDIT: Modified to be a "Save As" dialog instead of "File Open" dialog.
Sub TestFileDialog()
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = "D:\Temp\Testing.txt" ' Set suggested name for user
' This could be your "File2"
If Dlg.Show = -1 Then
Dim s As String
s = Dlg.SelectedItems.Item(1) ` Note that this is for single-selections!
Else
s = "No selection"
End If
MsgBox s
End Sub
Edit two: Based on comments, I cobbled together a sample that appears to do exactly what you want. You'll need to modify the variable assignments, of course, unless you're wanting to copy the same file from "D:\Temp" to "D:\Temp\Backup" over and over. :)
Sub TestFileMove()
Dim fso As FileSystemObject
Dim SourceFolder As String
Dim DestFolder As String
Dim SourceFile As String
Dim DestFile As String
Set fso = New FileSystemObject
SourceFolder = "D:\Temp\"
DestFolder = "D:\Temp\Backup\"
SourceFile = "test.txt"
Set InFile = fso.GetFile(SourceFolder & SourceFile)
DestFile = DestFolder & SourceFile
If fso.FileExists(DestFile) Then
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = DestFile
Do While True
If Dlg.Show = 0 Then
Exit Sub
End If
DestFile = Dlg.Item
If Not fso.FileExists(DestFile) Then
Exit Do
End If
Loop
End If
InFile.Move DestFile
End Sub
Here's some really quick code that I knocked up but basically looks at it from a different angle. You could put a combobox on a userform and get it to list the items as the user types. Not pretty, but it's a start for you to make more robust. I have hardcoded the directory c:\ here, but this could come from a text box
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
Dim varListing() As Variant
Dim strFilename As String
Dim strFilePart As String
Dim intFiles As Integer
ComboBox1.MatchEntry = fmMatchEntryNone
strFilePart = ComboBox1.Value
strFilename = Dir("C:\" & strFilePart & "*.*", vbDirectory)
Do While strFilename <> ""
intFiles = intFiles + 1
ReDim Preserve varListing(1 To intFiles)
varListing(intFiles) = strFilename
strFilename = Dir()
Loop
On Error Resume Next
ComboBox1.List() = varListing
On Error GoTo 0
ComboBox1.DropDown
End Sub
Hope this helps. On error resume next is not the best thing to do but in this example stops it erroring if the variant has no files