I need some help listing all the files and a specific folder. I used this tutorial and I cannot get it to work with the VBA.
Once on one drive, will this still work? If I follow the tutorial without VBA, the function doesn't list the file names...
Please help me.
Thanks,
VBA:
Function GetFileNames(ByVal FolderPath As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
Result(i) = MyFile.Name
i = i + 1
Next MyFile
GetFileNames = Result
End Function
Cell Function:
=IFERROR(INDEX(GetFileNames($A$1),ROW()-2),"")
A1:
=REPLACE(CELL("filename"),FIND("[",CELL("filename")),LEN(CELL("filename")),"*")
This actually prints out
https://...../Test/*
I had to remove the slash and * for it to work locally. But still not working on one drive
Related
I want a list of file names with a specific extension.
I am using this guide: https://trumpexcel.com/list-of-file-names-from-a-folder-in-excel/
The code doesn't return any values.
I entered the formula and it seems to return the value, however, it results in an error. I removed the IfError to test if it is even working. See screenshot:
With the full formula used together with IfError, nothing gets called out, which is not supposed to happen:
Full formula returns nothing
Function GetFileNamesbyExt(ByVal FolderPath As String, FileExt As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
If InStr(1, MyFile.Name, FileExt) <> 0 Then
Result(i) = MyFile.Name
i = i + 1
End If
Next MyFile
ReDim Preserve Result(1 To i - 1)
GetFileNamesbyExt = Result
End Function
I managed to resolve the issue. Turns out that my Row() portion is wrong.
Because I am putting the formula in Row 47, my formula should have been:
=IFERROR(INDEX(GetFileNamesbyExt($CK$44,$CK$45),ROW()-46),"")
Many thanks all!
I'm writing a script where I wish to write an HTML doc to a string from sharepoint.
Dim Content As String
Dim strShare As String: strShare = "\\link\to\share.html"
Dim iFile As Integer: iFile = FreeFile
Open strShare For Input As #iFile
Content = Input(LOF(iFile), iFile)
Close #iFile
However, I find I get a "path/file access error" every time I run the script for the first time upon boot. Once I visit "\link\to\share.html" in IE for the first time, the path begins to resolve in the VBA script.
My only thought is that IE is performing some sort of "DNS Cache" that VBA can't do. Currently my workaround is to catch the error and force the URL to open in IE the first time the script is run. After that, every other HTML file under that share loads fine.
As a test, I tried switching between from what I understand is http:// formatting (forward slash) and WebDAV formatting (\\ formating), and only the backslash separated paths ever work. I also tried to resolve the share to an IP and try it that way, but that never worked.
My last thought is to try mapping the share to a drive letter name and then specifically accessing the share with G:\link\to\mapped\share.html. But I don't see this as an elegant solution, and wonder if it will receive the same error any way.
Is there something blatant that I do not understand about WebDAV, Windows file handling, and VBA file inputs? There's something weird going on under the hood with resolving that shared domain, and I can't seem to debug it.
See if this helps here and an example below that I used.
2 things though: I only worked with Excel files on Sharepoint and I was already logged in there.
Dim oFSO As Object
'Dim oFolder As Object 'if needed
'Dim oFile As Object 'if needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("\\sharepoint.site.com#SSL\DavWWWRoot\sites\")
'For Each oFolder In oFolder.SubFolders 'loops through folders
' For Each oFile In oFolder.Files 'loops through files
' 'do stuff
' Next oFile
'Next oFolder
I'm a bit confused about what you want to do. Do you want to check out files from SP and check files back into SP?
Sub testing()
Dim docCheckOut As String
'docCheckOut = "//office.bt.com/sites/Training/Design Admin/Training Plan/adamsmacro.xlsm"
docCheckOut = "http://your_path_here/ExcelList.xlsb"
Call UseCheckOut(docCheckOut)
End Sub
Sub UseCheckOut(docCheckOut As String)
' Determine if workbook can be checked out.
If Workbooks.CanCheckOut(docCheckOut) = True Then
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
Or...do you want to list files in a SP folder?
Sub ListFiles()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
RowCtr = 1
FPath = "http://excel-pc:43231/Shared Documents"
For Each f In FPath
'Set folder = fs.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
Sub test()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'Set colSubfolders = objFolder.SubFolders
'For Each objSubfolder In colSubfolders
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
'Next
End Sub
I'm attempting to modify a VBA script from another post (26486871).
The script will download a Zip file, extract a text file and import the data to Excel.
I don't know VBA so I'll tackle each of the functions one at-a-time.
Create a temp directory with a randomized name................................Complete
Download a Zip file from a public server...............................................Complete
Extract the text file (20MB, tab-delimited)..............................................Error
Import the data into the open worksheet (overwrite the existing data)...Not Yet
On the Extract portion, I'm receiving a run-time error on the following line:
objOApp.Namespace(FileNameToUnzip).CopyHere objOApp.Namespace(varFileNameFolder).items, 256
"Run-time error '91: Object variable or With block variable not set."
When I hover my cursor over the variables while in Debug Mode, the directory and filenames are correct.
I'm unsure what is not set. I appreciate any help.
Option Explicit
'Main Procedure
Sub DownloadExtractAndImport()
Dim url As String
Dim targetFolder As String, targetFileZip As String, targetFileTXT As String
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim newSheet As Worksheet
url = "http://www.example.com/data.zip"
targetFolder = Environ("TEMP") & "\" & RandomString(6) & "\"
MkDir targetFolder
targetFileZip = targetFolder & "data.zip"
targetFileTXT = targetFolder & "data.txt"
'1 download file
DownloadFile url, targetFileZip
'2 extract contents
Call UnZip(targetFileZip, targetFolder)
End Sub
Private Sub DownloadFile(myURL As String, target As String)
Dim WinHttpReq As Object
Dim oStream As Object
Set WinHttpReq = CreateObject("Msxml2.ServerXMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile target, 1 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
Private Function RandomString(cb As Integer) As String
Randomize
Dim rgch As String
rgch = "abcdefghijklmnopqrstuvwxyz"
rgch = rgch & UCase(rgch) & "0123456789"
Dim i As Long
For i = 1 To cb
RandomString = RandomString & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next
End Function
Private Function UnZip(PathToUnzipFileTo As Variant, FileNameToUnzip As Variant)
Dim objOApp As Object
Dim varFileNameFolder As Variant
varFileNameFolder = PathToUnzipFileTo
Set objOApp = CreateObject("Shell.Application")
objOApp.Namespace(FileNameToUnzip).CopyHere objOApp.Namespace(varFileNameFolder).items, 256
End Function
Dim mainFolder As String
Dim zipFolder As String
Dim destinationFolder As String
Dim oShell As Object
Dim oMainFolder As Object
Dim oDestinatioFolder As Object
Dim oZipFolder As Object
Dim oZipItems As Object
replace with
Dim mainFolder As Variant
Dim zipFolder As Variant
Dim destinationFolder As Variant
Dim oShell As Object
Dim oMainFolder As Object
Dim oDestinatioFolder As Object
Dim oZipFolder As Object
Dim oZipItems As Object
Comintem is right, you should edit your old question with the added code rather than post a near identical new question. Perhaps keep this question and delete the old one.
To answer your question, it looks as if you're passing your arguments in the wrong order to your UnZip function. Try changing the line to:
Call UnZip(targetFolder, targetFileZip)
Update
It's difficult to diagnose the issues as your objects are being created and its properties/methods being called all on one line. Judging by the nature of your questions it doesn't seem as though your VBA knowledge is particularly vast and that you're trying to construct a working solution by tying various pieces of web code together. It's not my position to judge that kind of approach but my advice would be, if you take this approach, to create your objects one at a time and call its methods one at a time. This will make it far easier to diagnose your code.
I've tried to rewrite elements of your code to show you how this could be done. It might be a bit overkill but at least it'll help you identify the precise location of any problems. Obviously change the folder names to your own.
Dim mainFolder As String
Dim zipFolder As String
Dim destinationFolder As String
Dim oShell As Object
Dim oMainFolder As Object
Dim oDestinatioFolder As Object
Dim oZipFolder As Object
Dim oZipItems As Object
'Define the folder names
mainFolder = "C:\Users\User\Downloads\SO\" 'change to your own folder name
zipFolder = "sqlite-shell-win32-x86-3071700.zip" 'an old sqlite download = change to your name
destinationFolder = Left(zipFolder, Len(zipFolder) - 4) 'name of zip folder minus the '.zip'
'Create the new destination folder
MkDir mainFolder & destinationFolder
'Acquire the folder items
'create the shell object
Set oShell = CreateObject("Shell.Application")
'create the main folder object as Folder3 item
Set oMainFolder = oShell.Namespace(CVar(mainFolder)) 'argument must be a variant
'create the destination folder object as Folder3 item
Set oDestinatioFolder = oMainFolder.Items.Item(CVar(destinationFolder & "\")).GetFolder
'create the zip folder object as Folder3
Set oZipFolder = oMainFolder.Items.Item(CVar(zipFolder)).GetFolder
'Extract the zip folder items and write to desination folder
oDestinatioFolder.CopyHere oZipFolder.Items, 256
I have a file path (which is a connection path for the worksheet) in the following format:
C:\ExcelFiles\Data\20140522\File1_20140522.csv
I want to extract 20140522.
I tried using responses of How to extract groups of numbers from a string in vba, but they don't seem to work in my case.
please find below
Filename = "C:\ExcelFiles\Data\20140522\File1_20140522.csv"
a = Replace(Mid(Filename, InStrRev(Filename, "_") + 1, Len(Filename)), ".csv", "")
Try the following. Folder is selected.
Sub Folder_S()
Dim sFolder As FileDialog
On Error Resume Next
Set sFolder = Application.FileDialog(msoFileDialogFolderPicker)
If sFolder.Show = -1 Then
Folder_Select sFolder.SelectedItems(1), True
End If
End Sub
Sub Folder_Select(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim strFile As String
Dim FileName As Variant
Dim pathParts() As String
Dim pathPart As String
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
pathParts = Split(SourceFolder.Path, Application.PathSeparator)
pathPart = SourceFolder.Path
For i = 0 To UBound(pathParts)
If pathParts(i) = "20140522" Then
pathPart = pathParts(i - 0)
Exit For
End If
Next i
Row = ActiveCell.Row
With CreateObject("Scripting.Dictionary")
For Each FileItem In SourceFolder.Files
strFile = FileItem.Name
.Item(strFile) = Array(FileItem.Name)
Next FileItem
If .Count > 0 Then
For Each FileName In .Items
Cells(Row, 2).Formula = pathPart
Next FileName
End If
End With
End Sub
I found your question by searching a solution how to get a folder path from a file that is inside this folder path. But your question doesn't match exactly what I need. For those who by your question title will find it for the same purpose as I found, below is my function:
Function getFolderPathFromFilePath(filePath As String) As String
Dim lastPathSeparatorPosition As Long
lastPathSeparatorPosition = InStrRev(filePath, Application.PathSeparator)
getFolderPathFromFilePath = Left(filePath, lastPathSeparatorPosition - 1)
End Function
In some solutions for this purpose, I used FSO, but it takes resources, and I think it isn't worthy to create FSO object if you need it only for this simple function.
the accepted answer is not accurate to read the folder name. here is more dynamic code.
use splitter which splits string based on delimeter and makes an array. now read the second last element in array, thats the folder name.
Dim fileName As String
fileName = "C:\ExcelFiles\Data\20140522\File1_20140522.csv"
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
MsgBox (vPathSplitter(UBound(vPathSplitter) - 1))
The below answer gets your file path from a range, rather than a fixed string. Much more handy if your planning on getting your filename from your sheets, which I imagine you are.
Sub GetFileDate()
Dim filename As String
filename = Sheets("Sheet1").Range("C9").Value 'Or Wherever your file path is
MsgBox Replace(Right(filename, 12), ".csv", "")
End Sub
This assumes the numbers your extracting will ALWAYS be dates in YYYYMMDD format and the file type is always .csv
I'm trying to get the first file of a directory. I don't care that "first" is not well defined in this case, and I don't care if I'll get a different file each time I call my sub.
I try to use:
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
Set FileItem = SourceFolder.Files.Item(0)
but this returns a compiler error ("Invalid procedure call or argument")
Could you please tell me how to make this work?
Thanks,
Li
You may use the bulit in Dir function
Below is the sample code which returns the first file found name from Test folder.
Sub test()
Dim strFile As String
strFile = Dir("D:Test\", vbNormal)
End Sub
It looks to me like SourceFolder.Files will only accept a string as the key, just like you noted with Scripting.Folders. I think Santosh's answer is the way to go, but here's a kludgy modification of your code that returns the "first" file in the folder:
Sub test()
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim FileItemToUse As Object
Dim SourceFolderName As String
Dim i As Long
SourceFolderName = "C:\Users\dglancy\Documents\temp"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
For Each FileItem In SourceFolder.Files
If i = 0 Then
Set FileItemToUse = FileItem
Exit For
End If
Next FileItem
Debug.Print FileItemToUse.Name
End Sub
It’s true that VBA has a limitation (a bug or design flaw in my opinion) in which a file system object's Files collection cannot be accessed by item-index number, only by each item’s file-path string value. The original question posted here is about accessing only the first item in the Files collection but it touches on a general problem for which there are two reasonable workarounds: creation and use of either a File object meta-collection or a File object array to provide indexed access to a Files collection. Here’s a demo routine:
Sub DemoIndexedFileAccess()
'
'Demonstrates use of both a File object meta-collection and a File object array to provide indexed access
'to a Folder object's Files collection.
'
'Note that, in both examples, the File objects being accessed refer to the same File objects as those in
'the Folder object's Files collection. (i.e. if one of the physical files gets renamed after the creation
'of the Folder object's Files collection, all three sets of File objects will refer to the same, renamed
'file.)
'
'IMPORTANT: This technique requires a reference to "Microsoft Scripting Runtime" be set.
'
'**********************************************************************************************************
'File-selector dialog contsants for msoFileDialogFilePicker and msoFileDialogOpen:
Const fsdCancel As Integer = 0 'File dialog Cancel button
Const fsdAction As Integer = -1 'File dialog Action button, and its aliases...
Const fsdOpen As Integer = fsdAction
Const fsdSaveAs As Integer = fsdAction
Const fsdOK As Integer = fsdAction
Dim FD As FileDialog
Dim File As Scripting.File
Dim FileArr() As Scripting.File
Dim FileColl As New Collection
Dim Folder As Scripting.Folder
Dim FSO As Scripting.FileSystemObject
Dim Idx As Integer
'Get a folder specification from which files are to be processed
Set FD = Application.FileDialog(msoFileDialogFolderPicker) 'Create the FolderPicker dialog object
With FD
.Title = "Select Folder Of Files To Be Processed"
.InitialFileName = CurDir
If .Show <> fsdOK Then Exit Sub
End With
'Use the folder specification to create a Folder object.
Set FSO = New Scripting.FileSystemObject
Set Folder = FSO.GetFolder(FD.SelectedItems(1))
'A Folder object's Files collection can't be accessed by item-index number (only by each item's file-path
'string value), so either...
'1. Create a generic "meta-collection" that replicates the Files collection's File objects, which allows
' access by collection-item index:
For Each File In Folder.Files
FileColl.Add File
Next File
'"Process" the files in (collection) index order
For Idx = 1 To FileColl.Count
Debug.Print "Meta-Collection: " & FileColl(Idx).Name
Next Idx
'2. Or, create an array of File objects that refer to the Files collection's File objects, which allows
' access by array index:
ReDim FileArr(1 To Folder.Files.Count)
Idx = 1
For Each File In Folder.Files
Set FileArr(Idx) = File
Idx = Idx + 1
Next File
'"Process" the files in (array) index order
For Idx = LBound(FileArr) To UBound(FileArr)
Debug.Print "File Object Array: " & FileArr(Idx).Name
Next Idx
End Sub
I solve the problem in this Way:
Private Function GetFirstFile(StrDrive as String) As String
'Var Declarations
Dim Fso As Object, Drive As Object, F As File
'Create a reference to File System Object and Drive
Set Fso = New Scripting.FileSystemObject
Set Drive = Fso.GetDrive(StrDrive)
If Not Drive Is Nothing Then
'Scan files in RootFolder.files property of then drive object
For Each F In Drive.RootFolder.Files
Exit For
Next
'if there are any file, return the first an get then name
If Not F Is Nothing Then FirstFile = F.Name: Set F = Nothing
Set Drive = Nothing
End If
Set Fso = Nothing
End Function
Don´t forget add Reference to Microsoft Scripting Runtime in your project
It works to me... I hope this Help you guys.
Why don't you just use a function to iterate through the files in the folder until you get to the one that you want? Assuming you're using the fso as detailed in other posts above, just pass the Folder, and the Index of the file you want, it could be #1 or any other file in the folder.
Function GetFile(oFolder As Folder, Index As Long) As File
Dim Count As Long
Dim oFile As File
Count = 0
For Each oFile In oFolder.Files
Count = Count + 1
If Count = Index Then
Set GetFile = oFile
Exit Function
End If
Next oFile
End Function