I am working on a macro to output filenames. I have a directory containing log files for an industrial batch process. Each batch is assigned a 5-digit batch number, and for each batch there is a .csv and .txt file. The filename for both files is the same and contains the batch number, for example:
XYZ 53482 20180827.csv
XYZ 53482 20180827.txt
XYZ 53483 20180828.csv
XYZ 53483 20180828.txt
XYZ 53484 20180829.csv
XYZ 53484 20180829.txt
My macro so far is:
Sub FindBatchFile()
Dim Batch As Double
Dim DirPath As String, r As Integer
Batch = InputBox("Enter Batch Number")
DirPath = Dir("C:\Data\* " & Batch & "*", vbDirectory)
r = 1
Workbooks.Add
MsgBox (DirPath)
Do Until DirPath = ""
Cells(r, 1).Value = DirPath
MsgBox (DirPath)
r = r + 1
DirPath = Dir
Loop
End Sub
This works adequately but the output contains both .csv and .txt files. Is there a way of using multiple wildcards in the Dir function (ie. include a "*.csv" criterion as well as the "*Batch*")?
Many thanks in advance!
I believe the following will work as you expect it to, just added the .csv in your DirPath:
Sub FindBatchFile()
Dim Batch As Double
Dim DirPath As String, r As Integer
Batch = InputBox("Enter Batch Number")
DirPath = Dir("C:\Data\* " & Batch & "*.csv", vbDirectory)
r = 1
Workbooks.Add
MsgBox (DirPath)
Do Until DirPath = ""
Cells(r, 1).Value = DirPath
MsgBox (DirPath)
r = r + 1
DirPath = Dir
Loop
End Sub
Related
Hi there so I finished the section of a program which calculates and exports a csv with results. (ends up about 1600 csv files) each having only 1 column and between 20 and 0 rows. I would like my MS Access VBA program to join them together into one larger CSV. So Same header only once at the top of the new file.
The program i have so far seems to fall over at the part where it tries to import the Reg. Number of the File.
Dim db As DAO.Database
Set db = CurrentDb
MTH = Format(Date, "mmm")
UserInput = InputBox("Enter Country Code")
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Dim wks As Excel.Worksheet
Application.Echo False
'Change the path to the source folder accordingly
strSourcePath = "Q:\CCNMACS\AWD" & CTRY
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
'Change the path to the destination folder accordingly
strDestPath = "Q:\CCNMACS\AWDFIN"
If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1, strData
End If
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
wks.Cells(r, c + 1).Value = Trim(x(c)) 'Error is here: Run time error '91': Object variable or With Block variable not set
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strDestPath & strFile
strFile = Dir
Loop
Application.Echo True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation
Your question isn't absolutely definitive as to what you're trying to do, but if I understand correctly, you just need to append several files to the end of each other, to make "one big CSV".
If that's true then there are several ways to do this a lot simpler than using VBA. .CSV files are just plain text files with comma's separating each field, and a .CSV filename extension.
Personally I would use Notepad++ (I assume it's capable of this; it does everything else), or perhaps even easier, I would use the Windows Command Prompt.
Let's say you have a folder with files:
File1.csv
File2.csv
File3.csv
...etc
Open the Windows Command Prompt. (One way is with the Windows key + R, then type cmd and hit Enter.)
Change directory with to the file location using cd (same as ChDir).
(For example, you might use cd c:\users\myFolder,
and then hit Enter)
To combine all CSV's in the folder into one, you could use a command like:
copy *.csv combinedfile.csv
That's it!
A file is created named combinedfile.csv. You can open in Excel or a text editor (like Notepad) to double-check it and adjust manually if necessary.
Obviously there are many ways you could vary the command, like if you only wanted the files that start with the word File you could use:
copy file*.csv combinedFile.csv
This should do what you want.
Sub Import()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\your_path_here\"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "Table1"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, "", strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
See the links below for additional details pertaining to this topic.
https://anthonysmoak.com/2018/04/10/how-to-fix-an-import-specification-error-in-microsoft-access/
https://www.oakdome.com/programming/MSAccess_ExportSpecifications_TransferText_To_CSV.php
Below is the code so far
I often times have to check if a Purchase Order has been saved in a directory, there could be hundreds of purchase orders listed in Excel.
As the Workbook changes, so often does the filepath.
As such, I would like to make a function that asks for a cell value that contains a string for the filepath, and then a a cell for the PO #.
I'm a little stumped on how best to past information from the Excel sheet. I need a cell reference for the filepath to the directory, and a cell reference for the PO #.
I've been able to make this work with a subroutine, that is what is posted below. This is the third VBA Program I've worked on, please let me know if there is more legwork I should do before posting this:
Dim directory As String
Dim TempfileName As String
Dim i As Long
Dim x As Long
Sub Check_PO()
x = 2
Application.ScreenUpdating = False
For x = 2 To 673
While Cells(x, 14) = 0
x = x + 1
Wend
i = Cells(x, 14)
TempfileName = "\\network\file\name\here\" & "*" & i & "*.pdf"
directory = Dir(TempfileName, vbNormal)
While directory <> ""
Cells(x, 18) = "Matched"
directory = Dir
Wend
Next x
End Sub
Here's a simple UDF:
Public Function HaveReport(fPath As String, fileName As String)
HaveReport = IIf(Dir(fPath & fileName, vbNormal) <> "", _
"Matched", "Not Matched")
End Function
Usage:
I am using VBA to import data from .txt files into a table of my spreadsheet which I am using for further pivot charts. The network directory that I am importing the files from contains ~5500 files and will grow over time at about 2000 files per year currently. The entries in the table are sorted by date (oldest to newest).
I have a macro which checks the date of the most recent entry, then uses DIR to search the network location and iterate through the files in that directory. For each file, if the file is newer than the most recent entry, I want to import the data and add it to the table. If the file is older, I want DIR to move to the next file. Below is the code I am currently using.
Sub NewFilesFromNetwork()
Dim myDatabase As Worksheet
Set myDatabase = Sheets("Database")
Dim TotalRows As Long, LastDate As Date
TotalRows = myDatabase.ListObjects("Table1").Range.Rows.Count
LastDate = Cells(TotalRows + 48, 6).Value 'the "+48" here is important because there are 48 hidden rows at the top of the spreadsheet before the table starts
Dim MyFolder As String, MyFile As String
On Error Resume Next
Application.ScreenUpdating = False
MyFolder = "*path to my network location*"
MyFile = Dir(MyFolder & "*.txt")
Dim t As Integer, k As Integer
t = 0 'counter for calculating total files imported
k = 0 'counter for calculating total files checked
Do While MyFile <> ""
TxtFile = MyFolder & MyFile
If FileDateTime(TxtFile) > LastDate Then
Open TxtFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
Call CommonImportCode 'separate sub which picks out information from the .txt file string and adds it to the table as a new entry
k = k + 1
t = t + 1
MyFile = Dir()
End If
k = k + 1
MyFile = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Number of files searched = " & k & vbNewLine & "Number of files imported = " & t
End Sub
The issue I am having is this:
I can check the network location and see that there are 10 new files. However, the macro only imports 5 of them, and seems to be importing only every other file of the new files. Is there a reason the macro is skipping files when they meet the conditions of the IF statement?
k = k + 1
MyFile = Dir()
That code is duplicated. If your "If" just above is true, you are jumping one file. Your loop should be :
Do While MyFile <> ""
TxtFile = MyFolder & MyFile
If FileDateTime(TxtFile) > LastDate Then
Open TxtFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
Call CommonImportCode 'separate sub which picks out information from the .txt file string and adds it to the table as a new entry
t = t + 1
End If
k = k + 1
MyFile = Dir()
Loop
or something approaching.
I'm trying to create a macro that reads each *.txt file from a folder, and if the modification date matches the current one, copy the contents into a worksheet of the *.xls file. I've been checking a lot of the codes you have been sharing here, but I just can't make it work.
When debbuging, at the 8th line, I get an error:
438: Object doesn't support this property or method
Sub GetSAPfiles()
Dim Cont As Integer
Dim RootDir As String
RootDir = "\HOME\SAP\dir\"
SAPfile = Dir(RootDir)
Set SAPfile = CreateObject("Scripting.FileSystemObject")
Set SF = SAPfile.GetFile(RootDir + SAPfile)
Do While SAPfile <> ""
Dim ObjDate, CurrDate
CurrDate = Format(Now(), "MM/DD/YYYY")
ObjDate = Format(file.DateLastModified, "MM/DD/YYYY")
If CurrDate = ObjDate Then
Cont = Cont + 1
Dim TxtFl, Txt
Set TxtFl = SAPfile.OpenTextFile(RootDir + SAPfile)
Txt = TxtFl.ReadLine
ActiveSheet.Cells(Cont, "A").Value = Txt
ArchTxt.Close
End If
SAPfile = Dir(RootDir)
Loop
End Sub
Try something like this instead, use the command prompt to get an array of files and loop through them using the FSO to check the modified date and read the text into the next blank cell in column A:
Sub SO()
RootDir$ = "\HOME\SAP\dir\"
For Each x In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR " & RootDir & "*.* /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
With CreateObject("Scripting.FileSystemObject")
If DateValue(.GetFile(RootDir & x).DateLastModified) = Date Then _
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = .OpenTextFile(RootDir & x, 1).ReadAll
End With
Next x
End Sub
I need to open a file whose full filename I do not know.
I know the file name is something like.
filename*esy
I know definitely that there's only one occurrence of this file in the given directory.
filename*esy is already a "shell ready" wildcard & if thats alway the case you can simply;
const SOME_PATH as string = "c:\rootdir\"
...
Dim file As String
file = Dir$(SOME_PATH & "filename*esy" & ".*")
If (Len(file) > 0) Then
MsgBox "found " & file
End If
Just call (or loop until empty) file = Dir$() to get the next match.
There is an Application.FileSearch you can use (see below). You could use that to search for the files that match your pattern. This information taken from here.
Sub App_FileSearch_Example()
With Application.FileSearch
.NewSearch
.LookIn = "c:\some_folder\"
.FileName = "filename*esy"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
For i1 = 1 To .FoundFiles.Count
' do something with matched file(s)
Next i1
End If
End With
End Sub
If InStr(sFilename, "filename") > 0 and InStr(sFilename, "esy") > 0 Then
'do somthing
end if
Or you can use RegEx
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "filename(.*)esy"
End With
Set REMatches = RE.Execute(sFilename)
REMatches(0) 'find match
I was trying this question as a function. This is the solution that ended up working for me.
Function fileName(path As String, sName As String, ext As String) As Variant
'path is Full path from root. Can also use path = ActiveWorkbook.path & "\"
'sName is the string to search. ? and * are wildcards. ? is for single char
'example sName = "book?" or sName ="March_*_2014*"
'ext is file extention ie .pdf .xlsm .xls? .j*
Dim file As Variant 'Store the next result of Dir
Dim fname() As String 'Dynamic Array for result set
ReDim fname(0 To 0)
Dim i As Integer ' Counter
i = 0
' Use dir to search and store first result
fname(i) = path & Dir(path & "\" & sName & ext)
i = i + 1
'Load next result
file = Dir
While file <> "" 'While a file is found store that file in the array
ReDim Preserve fname(0 To i) As String
fname(i) = path & file
file = Dir
Wend
fileName = Application.Transpose(fname) 'Print out array
End Function
This works for me as a single or array function.
If you know that no other file contains "filename" and "esy" in that order then you can simply use
Workbooks.Open Filename:= "Filepath\filename*esy.*"
Or if you know the number of missing characters then (assuming 4 characters unknown)
Workbooks.Open Filename:= "Filepath\filename????esy.*"
I use this method to run code on files which are date & timestamped to ignore the timestamp part.