Wildcard for file path for adding attachments - vba

I want to add attachments from a specific folder. I specified the file's path and two keywords which are fixed.
There are more characters to complete the file path after 'filename2' and before 'pmonth' which are not fixed and hence I need to use wildcard (*).
The code gives
'Couldn't find file'
I have gone through various threads and tried solutions. None works for what I want.
For ctr = 2 To lastrow
filename1 = Cells(ctr, 1).Value
filename2 = Cells(ctr, 3).Value
Set OutMail = OutApp.CreateItemFromTemplate(str_template)
path = "C:\Users\nikunj.v.tripathi\Desktop\" & filename1 & "_" & filename2 & " -" & "*" & pmonth & " " & syear & ".xlsx"
With OutMail
.Attachments.Add path ' <----- this line gives error
.To = Cells(ctr, 10).Value
.cc = Cells(ctr, 11).Value
.htmlbody = Replace(.htmlbody, "#Month#", smonth)
.htmlbody = Replace(.htmlbody, "#CLIENT NAME#", Cells(ctr, 1).Value
.Save
End With
Next ctr

To use the Dir function effectively in this case, you'll need the path and the file name as two separate variables. Assuming you add another variable called filename, you could then utilise the following code...
...
path = "C:\Users\nikunj.v.tripathi\Desktop\"
filename = filename1 & "_" & filename2 & " -" & "*" & pmonth & " " & syear & ".xlsx"
...
filename = Dir(path & filename) ' Dir returns the filename of the first file matching
' the criteria, or returns an empty string if no match.
Do Until filename = ""
.Attachments.Add path & filename
filename = Dir ' Using Dir again returns the next file matching
' the criteria, or returns an empty string if no match.
Loop

Of course - Attachments.Add adds a single attachment and returns the Attachment object. How can it possibly add multiple attachments?
You can use Scripting.FileSystemObject to loop through all files in a folder and add one attachment at a time. See, for example
https://devblogs.microsoft.com/scripting/how-can-i-get-a-list-of-all-the-files-in-a-folder-and-its-subfolders/

Related

Hyperlink stops at spaces in FilePath in VBA

I want to give a Hyperlink to a sharedrive path in eMail generated through VBA. In my excel, mail distribution list, mail subject & file path are dynamic hence VBA is picking these details from that particular cell. Since FilePath has 'space', hyperlink is not taking the entire path. Kindly see my code below and let me know where am I wrong-
Sub Draft_Mail()
Dim OutApp As Object
Dim OutMail As Object
Dim Filepath As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Filepath = Worksheets("Macro").Range("F7")
With OutMail
.To = Worksheets("Macro").Range("F9").Text
.Cc = Worksheets("Macro").Range("F11").Text
.Subject = Worksheets("Macro").Range("F13").Text
.Attachments.Add Filepath
.htmlBody = "Hello-" & "<br/>" & "<br/>" & "Please find attached Reconciliation for " & Worksheets("Macro").Range("F5").Text & ". Click on this link to open the file- " & "<br/>" & "<br/>" & "" & Filepath & "" & "<br/>" & "<br/>" & "Regards"
.Display
End With
End Sub
The href will need to be within quotes, like this...
"<A href='" & Filepath & "'>" & Filepath & "</A>"
Alternatively, you can replace any spaces in the file path with the url-encoded version %20 like this...
"" & FilePath & ""

How can I delete a file based on cell value?

I'm having trouble deleting a file based on cell value.
I get an error message on the line with the Kill command below:
Kill path & r.Offset(1, -4) & "\" & r.Offset(1, -3)
Any ideas?
Sub INACTIVE_files()
Const path = "C:\Users\NikolouzosD\AppData\Local\Temp\vbakillfunction\"
Dim r As Range
Dim x As Integer
Set r = Cells(1, 5)
Do Until r = ""
If UCase(r.value) = "INACTIVE" Then
Kill path & r.Offset(1, -4) & "\" & r.Offset(1, -3)
End If
Set r = r.Offset(1, 0)
Loop
End Sub
The code starts from cell E1 and looks for INACTIVE files in the same column, until there's no more files to look for.
Then, it checks the folder name (Column A), combines it with the Cube (Column B)
and puts both of them in a path:
path = "C:\Users\NikolouzosD\AppData\Local\Temp\vbakillfunction\"
so for example:
for cell E2 which is INACTIVE, the path should be:
C:\Users\NikolouzosD\AppData\Local\Temp\vbakillfunction\WPO 17 02 04 3MMT All Periods\BG023104.txt
It then deletes the INACTIVE files (Cubes) from the appropriate folder.
Wrap your path in double quotes to avoid issues with spaces in filenames and folders.
Even better is to put the path in a string variable so you can debug it easily
Outside your loop:
Dim strPath As String
Inside your if block:
strPath = """" & path & r.Offset(1,-4) & "\" & r.Offset(1,-3) & """"
Debug.Print strPath ' Ctrl-G to view results
Kill strPath
EDIT - add a check for file before deleting
Under Tools | References
Add a reference to Windows Script Hosting
Then at top of sub code add
Dim fso as New FileSystemObject
Replace your Kill command with a check for existence
If fso.FileExists(strPath) Then
Kill strPath
Else
Msgbox "File Doesn't Exist: " & strPath
End If
UPDATED FOR CONTINUE TO NEXT FILE
Change loop to be:
Do Until r = ""
If UCase(r.value) = "INACTIVE" AND fso.FileExists(strPath) Then
Kill strPath
End If
Set r = r.Offset(1, 0)
Loop
It works!
I've commented out some parts of the code that were used for checking if a file exists.
Sub delete_INACTIVE_files()
Const path = "C:\Users\Dn\AppData\Local\Temp\vbakillfunction\"
Dim r As Range
Set r = Cells(1, 5)
Do Until r = ""
If UCase(r.Value) = "INACTIVE" Then
If Dir(path & r.Offset(0, -4) & "\" & r.Offset(0, -3) & ".txt") <> "" Then 'Does the file exist?
'MsgBox "file" & path & r.Offset(0, -4) & "\" & r.Offset(0, -3) & ".txt" & " exists"
Kill path & r.Offset(0, -4) & "\" & r.Offset(0, -3) & ".txt"
'Else
'MsgBox "file" & path & r.Offset(0, -4) & "\" & r.Offset(0, -3) & ".txt" & " not here"
End If
End If
Set r = r.Offset(1, 0)
Loop
End Sub

VBA dir() returns empty string

I'm trying to get this vba working. It reads the correct filestructure and it does find the first .xlsx and it import the needed data to the control.xlsm.
I notice that after it gets to fileName = dir() the fileName becomes empty. I read that it does this because it cannot find files that match the criteria, but what am i doing wrong?
Here is the code
Sub test_werk_final()
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.DisplayAlerts = False
Dim directory, fileName As String, sheet As Worksheet
directory = ThisWorkbook.Path & "\"
fileName = Dir(directory & "*.xlsx")
controlFile = Dir(directory & "control.xlsm")
lijn = 2
MsgBox "1" & directory & "2" & fileName & "3" & controlFile
Do Until fileName = ""
MsgBox "1" & directory & "2" & fileName & "3" & controlFile
Workbooks.Open fileName:=(directory & fileName)
MsgBox "1" & directory & "2" & fileName & "3" & controlFile
naam = Sheets("Sheet2").Range("A1").Value
leeftijd = Sheets("Sheet2").Range("A2").Value
Workbooks(controlFile).Worksheets("control").Cells(lijn, 1) = naam
Workbooks(controlFile).Worksheets("control").Cells(lijn, 2) = leeftijd
For Each sheet In Workbooks(fileName).Worksheets
naam = Workbooks(fileName).Worksheets.Range("A1").Value
leeftijd = Workbooks(fileName).Worksheets.Range("A2").Value
Workbooks(controlFile).Worksheets("control").Cells(lijn, 1) = naam
Workbooks(controlFile).Worksheets("control").Cells(lijn, 2) = leeftijd
Next sheet
Workbooks(fileName).Close
MsgBox "1" & directory & "2" & fileName & "3" & controlFile
lijn = lijn + 1
MsgBox "1" & directory & "2" & fileName & "3" & controlFile
fileName = Dir() ' volgende
MsgBox "1" & directory & "2" & fileName & "3" & controlFile
Loop
Application.ScreenUpdating = True
I'm not an expert coding guru, but i do posses basic programming skills.
P.S: i already looked for the questone on differnt fora en didn't find anything that could help me. Maybe i used the wrong search string.
Thanks in advance
You should simple change the order of the two Dir-statements:
controlFile = Dir(directory & "control.xlsm")
fileName = Dir(directory & "*.xlsx")
When you issue a Dir-command with parameter, a new search is started according to the pattern you pass. Dir-command without parameter fetches the next file matching that pattern. In your code, you started first a search with wildcards and then a second search with a fixed filename. When you start your loop, the dir-command will try to find another file with name control.xlsm and of course fails.

Trying to add an attachment to an email from excel where only the first part of the file name is known

I have a macro which I am using to attach an automatically generated file to an email on a daily basis.
The filename is required to be a certain format which includes the date and time, and as this is automatic, only the date will be known inherently (without manually checking the file).
I am using .Attachments.Add and format(date... etc.) to get the second part of the file name.
The first part is a number and a word which don't change
but the third part (shown as "*.csv" below) is the bit that is causing the issue.
I have tried to substitute * like I saw on a forum but it where it seemed to work in that example it is not working for me. Am I missing something?
.Attachments.Add ("G:\AML, CFT & Sanctions\Sanctions\KYC6 Person & Organsation Reports\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm") & "\65436546_Test_" & Format(Date, "yyyymmdd") & "*.csv")
As #Kostas suggested, you can find files by a glob with the Dir function. Note that it only returns filename, without a path.
Do handle the case when nothing or more than one file matches the pattern. (My code produces an error in these cases; error codes are taken from http://www.halfile.com/vb.html .)
Dim date_ As Date, pattern, dir_, filename As String: date_ = Date
dir_ = "C:\Users\Ivan\Documents\test & test\" & _
Format(date_, "yyyy\\mmmm\\")
pattern = "65436546_Test_" & Format(date_,"yyyymmdd") & "*.csv"
filename = Dir(dir_ & pattern)
If Len(filename) = 0 Then Error 53 'File not found
If Len(Dir()) <> 0 Then Error 58 'More than one matching file
<email>.Attachments.Add(dir_ & filename)
Build the file path first, test it and attach it if it's valid. As advised in comments, you need to supply a concrete file name, wildcards are not allowed.
Dim path_ As String, name_ As String, file_ As String
path_ = "C:\Some folder\"
name_ = "*.csv"
file_ = Dir(strPath & name_)
If Len(Dir(path_ & file_)) > 0 Then
.Attachments.Add path_ & file_
End If

Access Vba Copy file with part random name

I have code in access VBA to copy file form serwer to user path
FromPath = "\\xx.xx.xx.xx\zz.zzzz\" & folder & "\"
ToPath = "C:\newfolder\" & b & "\"
File = barkod & ".tif"
FileCopy FromPath & File, ToPath & File
barcode is string
I have file that name is barcode_"random alphanumeric characters".tif
how yo copy this file with random alphanumeric characters in name
this is example of file name:
412355557816_17385084
412355557816_15987047
Code like this isn't working :(
File = master & "_" & "*" & ".tif"
What should be in "*"?
Another proposal, using dir command to list files matching a certain pattern
FromPath = "\\xx.xx.xx.xx\zz.zzzz\" & folder & "\"
ToPath = "C:\newfolder\" & b & "\"
f = Dir(FromPath & barkod & "*.tif")
While f <> ""
FileCopy FromPath & f, ToPath & f
f = Dir()
Wend
Use like in combination with the wildcard operator *
Sub testlike()
barcode = "412355557816*"
If "412355557816_17385084" Like barcode Then
Debug.Print "Match"
End If
End Sub