I'm quite new with VBA and am trying to use a code that I found online. However, when I run the code I get the error that I'm having a bad file name or number. When I look in the Locals window the path and file name seem to be expressed. Does anyone have an idea how to fix this?
Public Sub Create_KMZ_File_Filled_Circles()
Dim KMLfileName As String, KMZfullName As String
Dim KMLfullName As Variant, ZIPfullName As Variant 'must be Variants for WShell functions
Dim folderPath As String
Dim data As Variant
Dim WShell As Object
Dim fn As Integer
Dim Circle_Coords() As Double
Dim i As Long, r As Long
folderPath = ThisWorkbook.Path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
KMLfileName = "Circles Filled.kml"
KMLfullName = folderPath & KMLfileName
KMZfullName = Replace(KMLfullName, ".kml", ".kmz")
'Put sheet data in array
data = ThisWorkbook.Worksheets("Sheet1").UsedRange
fn = FreeFile
Open KMLfullName For Output As #fn
I'm working with sharepoint - could that create the issue?
Related
I tried to get the number of lines of data in several CSV files in VBA.
Here is the code.
Sub Woo_Products()
Dim fso As New FileSystemObject
Dim flds As Folders
Dim fls As Files
Dim strText As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim extfind As String
Dim FilePath As String
Dim sLineOfText As String
On Error Resume Next
Workbooks.Open Filename:="F:\Work\scrape\" & "woocommerce-products.csv", UpdateLinks:=3
Set fls = fso.getfolder("C:\Users\star\Downloads").Files
k = 2
For Each f In fls
strText = f.Name
extfind = Right$(strText, Len(strText) - InStrRev(strText, "."))
If extfind = "csv" Then
FilePath = "C:\Users\star\Downloads\" & strText
Open FilePath For Input As #1
i = 0
Do Until EOF(1)
Line Input #1, sLineOfText
If sLineOfText <> "" Then i = i + 1
Loop
Close #1
End If
Next
Windows("woocommerce-products.csv").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
But I am getting the same count for each file.
Of course, each file has different lines of data.
Hope to help me for this.
If all you need is a line count, I would write a function to return the count.
Function getFileLineCount(FullFileName As String, Optional LineDelimiter As String = vbNewLine) As Long
Dim text As String
Dim fileNo As Integer, n As Long
fileNo = FreeFile
Open FullFileName For Input As #fileNo
Do Until EOF(1)
Line Input #1, text
n = n + 1
Loop
Close #fileNo
getFileLineCount = n
End Function
Another approach using FileSystemObject:
Public Function GetLineCount(ByVal Path As String) As Long
With CreateObject("Scripting.FileSystemObject")
GetLineCount = UBound(Split(.OpenTextFile(Path, 1).ReadAll, vbNewLine)) + 1
End With
End Function
You'll need to add the references (Tools --> References)
Microsoft Scripting Runtime
Microsoft VBScript Regular Expressions 5.5
This will count "Return & NewLine" characters in the file.
Private Function LineCount(ByVal PathFile As String) As Long
Dim sData As String
Dim oFile As New FileSystemObject
sData = oFile.OpenTextFile(PathFile, ForReading).ReadAll
Dim oRegX As New RegExp
oRegX.Pattern = "\r\n"
oRegX.Global = True
LineCount = oRegX.Execute(sData).Count + 1
Set oRegX = Nothing
Set oFile = Nothing
End Function
i = ActiveWorkbook.ActiveSheet.Cells(ActiveWorkbook.ActiveSheet.Rows.Count, 1).End(xlUp).Row
It's working so well.
I am attempting to pull a column of letter codes using InStr from existing text files. I would like to allow this macro to be flexible enough to allow the option to manually input the letter code being searched.
Where I am running into an issue is when common numbers are in the letter code (i.e. C4 and C45). Originally the code was written to search for 2 specific letter codes, and I was hoping to be able to replace those 2 identifiers with a link to 2 cells.
No such luck, as I keep getting responses that are not exact. Please see the code below:
Private Sub CmdLettersGetfile_Click()
Dim objFSO As Object
Dim myDir As String, myList()
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim sFolder As String
Dim fd As Office.FileDialog
Dim row As Long
Dim row1 As Long
Dim FCount As Integer
Dim FCount1 As Integer
Dim Val As String
Dim Pos As Integer
Dim Last1 As Long 'Mark the last row
Dim Start2 As Long
Dim Last2 As Long 'Mark the last row
Set fd = Application.FileDialog(msoFileDialogFilePicker)
For Each cn In ThisWorkbook.Connections
cn.Delete
Next cn
With ActiveSheet
Lastrow = Sheets("MAIN").Cells(.Rows.Count, "E").End(xlUp).row
End With
'
Worksheets("REPORT").Range("A6:AA1000000").ClearContents
Worksheets("REPORT").Range("A6:AA1000000").ClearFormats
row1 = 6 'Start of REPORT ROW
For row = 12 To Lastrow
sFile = Worksheets("MAIN").Cells(row, "E").Value
Pos = InStr(1, sFile, "org")
If Pos = 0 Then
Val = Worksheets("MAIN").Cells(9, "H")
Else
Val = Worksheets("MAIN").Cells(10, "H")
End If
Pos = 0
Dim strFilename As String
Dim strTextLine As String
Dim iFile As Integer
iFile = FreeFile
strFilename = folderName & "\" & sFile
Open strFilename For Input As #iFile
Last1 = 0
Last2 = 0
Do Until EOF(1)
Line Input #1, strTextLine
FCount = FCount
Pos = InStr(1, strTextLine, Val)
I cleaned up some of the irrelevant code in an attempt to save space and focus on the lines where I am having the issue.
********Update (26-Apr-2018 # 18:12 EST):
When I tried to format the Val to be one uppercase letter and 2 numbers
Dim Val As String: Val = "([A-Z]{1})([0-9]{1})([0-9]{1})"
I get the following:
Resulting data
Column I is the letter code that I need to get narrowed down.
*********Update 2 (27-Apr-2018 # 14:37 EST):
Expanded resulting data
I was able to mass redact what I needed to. I hope this offers more insight into what I'm looking to do.
I want to open, using VBA, a workbook from a certain path that includes a number, for example 2. Any variation I tried is not working.
The name of the workbook is in Hebrew except for the number, so I want the VBA code to base the file name on the number to open the file.
I have 4 letters in hebrew before the number. In Hebrew we write from right to left.
Here is my code:
Set WB1 = Workbooks.Open("C:\RESULTS\" 2 & ".xlsx")
Thanks for helping.
Try this
Dim sFound As String, fPath As String
fPath = "C:\RESULTS\"
sFound = Dir(fPath & "*2*.xlsx") 'get the first file in dir
If sFound <> "" Then
Set WB1 = Workbooks.Open(fPath & sFound)
End If
This works for me:
Option Explicit
Sub TestMe()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim wbs As Workbook
Dim strExtension As String
Dim lngNumber As String
Dim lngAdditional As Long
Dim lngLenFile As Long
strExtension = ".xlsx"
lngNumber = 20
lngAdditional = 4
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\Desktop\")
lngLenFile = Len(strExtension) + Len(lngNumber) + lngAdditional
For Each objFile In objFolder.Files
If Left(objFile.Name, Len(lngNumber)) = lngNumber And _
Right(objFile, Len(strExtension)) = strExtension And _
Len(objFile.Name) = lngLenFile Then
Debug.Print objFile.Name
Set wbs = Workbooks.Open(objFile)
End If
Next objFile
End Sub
The idea of the code is to make it flexible, thus, lngNumber and strExtension are added. It checks always for the size, as well as for right and left. Thus 24Some.xlsx would be different than 2Some.xlsx.
Debug.Print is added to see the file that is opened.
lngAdditional is added, for the additional 4 chars.
I have many projects where I have the same variables across multiple modules. In each module I dim and set the variables and each time they are the same variable type and have the same value. How do I dim and set variables across an entire project/workbook?
Ex: (I have many modules in a workbook where I have had to repeat all of the following along with many other similar variables that do not change across modules)
Sub PullSFAFiles()
Dim Wb As Workbook
Dim WsSFAFiles As Worksheet
Dim WsAllCourses As Worksheet
Dim rngAllCourses As Range
Dim rngCourse As Range
Dim LoSFAFiles As ListObject
Dim rngPreviousFiles As Range
Dim rngRemoveLines As Range
Dim strCourse As String
Dim strApp As String
Dim strPeCFldrPath As String
Dim strFileLocation As String
Dim strFileNm As String
Dim objFile As Object
Dim intSFARow As Integer
Dim intCourseRow As Integer
Dim intPFilesRow As Integer
Dim dtLastUpdate As Date
Dim intNumRemove As Integer
Set Wb = ThisWorkbook
Set WsSFAFiles = Wb.Sheets("sfafiles")
Set WsAllCourses = Wb.Sheets("allcourses")
Set rngAllCourses = WsAllCourses.Range("tblAllCourses[CourseName]")
Set LoSFAFiles = WsSFAFiles.ListObjects("tblSFAFiles")
strEBTypeFolder = "Exercise Booklet"
strEBfiletype = "EB"
strCISTypeFolder = "Classroom Information Sheet"
strCISfiletype = "CIS"
intCourseRow = rngCourse.Row - 1
strCourse = rngCourse.Value
strApp = WsAllCourses.Range("tblallcourses[application]").Rows(intCourseRow)
strPeCFldrPath = "\\Cx138\training\Live\Credentialed Trainers\"
strEBFileLocation = strApp & "\" & strTypeFolder & "\" & strCourse & "_" & strEBfiletype & "*" & ".pdf"
strEBFileNm = Dir(strPeCFldrPath & "\" & strEBFileLocation)
strCISFileNm = Dir(strPeCFldrPath & "\" & strCISFileLocation)
Replace variable declaration Dim with Public. Thus:
Public rngCourse as Range
Public strCourse As String
Declare them at module level.
This question already has answers here:
Cycle through sub-folders and files in a user-specified root directory [duplicate]
(3 answers)
Closed 1 year ago.
I need to get the names of all the Excel files in a folder and then make changes to each file. I've gotten the "make changes" part sorted out. Is there a way to get a list of the .xlsx files in one folder, say D:\Personal and store it in a String Array.
I then need to iterate through the list of files and run a macro on each of the files which I figured I can do using:
Filepath = "D:\Personal\"
For Each i in FileArray
Workbooks.Open(Filepath+i)
Next
I had a look at this, however, I wasn't able to open the files cause it stored the names in Variant format.
In short, how can I use VBA to get a list of Excel filenames in a specific folder?
Ok well this might work for you, a function that takes a path and returns an array of file names in the folder. You could use an if statement to get just the excel files when looping through the array.
Function listfiles(ByVal sPath As String)
Dim vaArray As Variant
Dim i As Integer
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
If oFiles.Count = 0 Then Exit Function
ReDim vaArray(1 To oFiles.Count)
i = 1
For Each oFile In oFiles
vaArray(i) = oFile.Name
i = i + 1
Next
listfiles = vaArray
End Function
It would be nice if we could just access the files in the files object by index number but that seems to be broken in VBA for whatever reason (bug?).
You can use the built-in Dir function or the FileSystemObject.
Dir Function: VBA: Dir Function
FileSystemObject: VBA: FileSystemObject - Files Collection
They each have their own strengths and weaknesses.
Dir Function
The Dir Function is a built-in, lightweight method to get a list of files. The benefits for using it are:
Easy to Use
Good performance (it's fast)
Wildcard support
The trick is to understand the difference between calling it with or without a parameter. Here is a very simple example to demonstrate:
Public Sub ListFilesDir(ByVal sPath As String, Optional ByVal sFilter As String)
Dim sFile As String
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
If sFilter = "" Then
sFilter = "*.*"
End If
'call with path "initializes" the dir function and returns the first file name
sFile = Dir(sPath & sFilter)
'call it again until there are no more files
Do Until sFile = ""
Debug.Print sFile
'subsequent calls without param return next file name
sFile = Dir
Loop
End Sub
If you alter any of the files inside the loop, you will get unpredictable results. It is better to read all the names into an array of strings before doing any operations on the files. Here is an example which builds on the previous one. This is a Function that returns a String Array:
Public Function GetFilesDir(ByVal sPath As String, _
Optional ByVal sFilter As String) As String()
'dynamic array for names
Dim aFileNames() As String
ReDim aFileNames(0)
Dim sFile As String
Dim nCounter As Long
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
If sFilter = "" Then
sFilter = "*.*"
End If
'call with path "initializes" the dir function and returns the first file
sFile = Dir(sPath & sFilter)
'call it until there is no filename returned
Do While sFile <> ""
'store the file name in the array
aFileNames(nCounter) = sFile
'subsequent calls without param return next file
sFile = Dir
'make sure your array is large enough for another
nCounter = nCounter + 1
If nCounter > UBound(aFileNames) Then
'preserve the values and grow by reasonable amount for performance
ReDim Preserve aFileNames(UBound(aFileNames) + 255)
End If
Loop
'truncate the array to correct size
If nCounter < UBound(aFileNames) Then
ReDim Preserve aFileNames(0 To nCounter - 1)
End If
'return the array of file names
GetFilesDir = aFileNames()
End Function
File System Object
The File System Object is a library for IO operations which supports an object-model for manipulating files. Pros for this approach:
Intellisense
Robust object-model
You can add a reference to to "Windows Script Host Object Model" (or "Windows Scripting Runtime") and declare your objects like so:
Public Sub ListFilesFSO(ByVal sPath As String)
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Set oFSO = New FileSystemObject
Set oFolder = oFSO.GetFolder(sPath)
For Each oFile In oFolder.Files
Debug.Print oFile.Name
Next 'oFile
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
If you don't want intellisense you can do like so without setting a reference:
Public Sub ListFilesFSO(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
For Each oFile In oFolder.Files
Debug.Print oFile.Name
Next 'oFile
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Dim iIndex as Integer
Dim ws As Excel.Worksheet
Dim wb As Workbook
Dim strPath As String
Dim strFile As String
strPath = "D:\Personal\"
strFile = Dir(strPath & "*.xlsx")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strPath & strFile)
For iIndex = 1 To wb.Worksheets.count
Set ws = wb.Worksheets(iIndex)
'Do something here.
Next iIndex
strFile = Dir 'This moves the value of strFile to the next file.
Loop
If all you want is the file name without file extension
Dim fileNamesCol As New Collection
Dim MyFile As Variant 'Strings and primitive data types aren't allowed with collection
filePath = "c:\file directory" + "\"
MyFile = Dir$(filePath & "*.xlsx")
Do While MyFile <> ""
fileNamesCol.Add (Replace(MyFile, ".xlsx", ""))
MyFile = Dir$
Loop
To output to excel worksheet
Dim myWs As Worksheet: Set myWs = Sheets("SheetNameToDisplayTo")
Dim ic As Integer: ic = 1
For Each MyFile In fileNamesCol
myWs.Range("A" & ic).Value = fileNamesCol(ic)
ic = ic + 1
Next MyFile
Primarily based on the technique detailed here: https://wordmvp.com/FAQs/MacrosVBA/ReadFilesIntoArray.htm
Regarding the upvoted answer, I liked it except that if the resulting "listfiles" array is used in an array formula {CSE}, the list values come out all in a horizontal row. To make them come out in a vertical column, I simply made the array two dimensional as follows:
ReDim vaArray(1 To oFiles.Count, 0)
i = 1
For Each oFile In oFiles
vaArray(i, 0) = oFile.Name
i = i + 1
Next
Sub test()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder1 = FSO.GetFolder(FromPath).Files
FolderPath_1 = "D:\Arun\Macro Files\UK Marco\External Sales Tool for Au\Example Files\"
Workbooks.Add
Set Movenamelist = ActiveWorkbook
For Each fil In folder1
Movenamelist.Activate
Range("A100000").End(xlUp).Offset(1, 0).Value = fil
ActiveCell.Offset(1, 0).Select
Next
End Sub