I'm putting together a VBA code to attach a document to an email, but I only have the first part of the document name to be attached. I've tried using "*" at the end so that it finds the document with what I have, but that's not working. Could anyone help? This is what I have:
If EmailType = "KiteWorks" Then
.Attachments.Add ("File Path (redacted)\Results Enquiry " & AppLog.Cells(BatchRow, 2).Value & " " & BatchNumber & "*")
End If
(this section is within a with)
I'm testing with a document that is called "Result Enquiry 2 2 [Art].pdf" but I keep getting an error that the name or directory is not valid. I believe the issue is with the wildcard "*" that I hoped would fill in for the "[Art].pdf"
Thank you very much in advance.
Thank you BigBen for making me realise how silly I was being...
Updated my code to:
If EmailType = "KiteWorks" Then
FilePath = "Path Redacted" & "\Results Enquiry " & AppLog.Cells(BatchRow, 2).Value & " " & BatchNumber & "*"
FileExists = Dir(FilePath)
If FileExists = "" Then
MsgBox "Could not find PDF of script in scanned folder."
Else
.Attachments.Add ("Path Redacted" & FileExists)
End If
End If
Related
I have the following VBA Script which I use to extract multiple attachments from multiple emails. But when I use it, the email is then left with a marker
I can see the point in the below script and wish to remove this, however when I do and try run again, I get a Compile Error.
What do I need to remove correctly to be able to run the script by leaving the marker?
End If
Next i
If xSaveFiles <> "" Then
If xMailItem.BodyFormat <> olFormatHTML Then
xMailItem.Body = vbCrLf & "The file(s) were saved to " & xSaveFiles & vbCrLf & xMailItem.Body
Else
xMailItem.HTMLBody = "<p>" & "The file(s) were saved to " & xSaveFiles & "</p>" & xMailItem.HTMLBody
End If
End If
xMailItem.Save
End If
Next
I've had the hardest time figuring out the below code
I am trying to save many files over the course of a day into one directory with the same name, except with a number that marks it in a successive fashion.
I have searched stackoverflow, but cannot seem to understand where I put the Save As line, within the loop to increment by one? Well, that didn't work and neither did many other tries.
Please kindly advise on this :)
Sub AutoSave()
Dim filename As String, filepath As String, filecount As Integer, filedate
As String
filedate = Format(Now(), "MM-DD-YYYY")
filepath = "C:\Users\nabil\OneDrive\Documents"
filecount = filecount + 1
Set book = Workbooks.Open("Nabil 06-06-2019 #1 Lincoln.xlsx")
' code to copy and paste here
If Len(Dir(filepath & filename)) <> 0 Then
filecount = filecount + 1
filename = "Nabil " & filedate & " " & "#" & filecount & " " & "Lincoln"
ActiveWorkbook.SaveAs filename:= _ "C:\Users\nabil\OneDrive\Documents\Nabil
" & filedate & " " & "#" & filecount & " " & "Lincoln" & ".xlsx"
End If
End Sub
Thanks for the help Mathieu. I have now edited it like this above
But now it does not want to Save As , when I put the save as in the loop or if-then statement. If I put it after the loop , then it prompts me to save over the existing file name, not saving as the file name with an increment of 1 (.e.g, #2)
This is a sliver of the code I'm using which requires that I operate from the macro workbook and open a blank template and paste data onto it , and then save as throughout the day
Please kindly advise :)
I need this code to copy the Word file and call it a value from the active cell
FileCopy Application.ThisWorkbook.path & "\template.docx", Application.ThisWorkbook.path & "\exercies\ & Worksheets(1).ActiveCell.Value & "".docx"
But it gives me an error "Bad file of number".
Can someone help me?
The problem is this part of your code:
"\exercies\ & Worksheets(1).ActiveCell.Value & "".docx"
If you Debug.Print this part of the statement, you'll get:
\exercies\ & Worksheets(1).ActiveCell.Value & ".docx
which is not a valid path.
Try replacing it with this instead:
"\exercies\" & ActiveCell.Value & ".docx"
which will produce a valid path. Furthermore, I suspect you have misspelled the folder name. Shouldn't it be exercises instead?
I've receive the above error for the following code:
Dim location_results As String
location_results = Worksheets("merging").Range("B1").Text 'absorbing the initial computation results folder
file_results = Dir$(location_results & "\" & "*" & NBDID & "*" & ".*") 'checks if there is a file with NBDID in the "location results folder
If (Len(file_results) > 0) Then
Worksheets("list").Range("D" & i).Value = file_results
Else
MsgBox (NBDID & " result not found")
End If
'problem todoB:
lineD:
Dim shortlocation As String
shortlocation = ThisWorkbook.Path & "\megaresults\" & file_results
On Error GoTo lineD
'Workbooks(shortlocation).Open
Set InputFile = Workbooks.Open(FileName:=shortlocation)
'Set InputFile = Workbooks.Open(location_results & file_results)
Set OutputFile = Workbooks.Open(location_merger & file_merger)
On Error GoTo 0
The error is raised on the line:
Set InputFile = Workbooks.Open(location_results & file_results)
and on the line:
Set InputFile = Workbooks.Open(FileName:=shortlocation)
Now googling that error, nearly everyone has an issue that the file they are trying to open is not in the parents-workbook folder, or that they did not preappend their path to the file specification.
I have done that however, and the path is validated, both manually by me checking whether the file is in the folder, as well as with:
If (Len(file_results) > 0) Then
Worksheets("list").Range("D" & i).Value = file_results
Else
MsgBox (NBDID & " result not found")
End If
, the file exists, and the total path, including file name and extention is 222 characters long. It also contains spaces.
But I can't find any reason for it to return as an error. On top of that, the on error goto lineD does not function, it still pops up with a message that does not allow continuing of the code.
Could someone point out my mistake to me, or give me a solution that would work?
Kind regards.
Could someone please help me out with a way to loop through the directory of the current file and search for the file to see if it exists, if it does then count the number of files with version numbers already and increment the next number, if it does not exist then create the file like normal.
Basically I have a vba macro that allows you to extract a slide pack from a 'master template' which they are all stored. The user clicks on the pack that they want and the pack gets extracted and saved out into that same directory. My problem is there is no version control or file protection setup. Could someone please help me work out how to do a loop and increment the version numbers.
Option Explicit
Public Sub CreatePack(control As IRibbonControl)
Dim packName As String
Dim Count As Integer
Select Case control.Id
Case "packbutton_B1"
packName = "B1"
Case "packbutton_B2"
packName = "B2"
Case "packbutton_TSD"
packName = "TSD"
End Select
'Note: Attempt to remove characters that are not file-system friendly
Dim Title As String
If ActivePresentation.Slides(1).Shapes.Count >= 9 Then
Title = Trim(ActivePresentation.Slides(1).Shapes(9).TextEffect.Text)
If Title = "" Then MsgBox "Warning: A project title has not been entered on Slide 1."
Else
Title = "(Project Title Not Known)"
MsgBox "The title slide has been removed, the project name cannot be detected."
End If
Title = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Title, "/", ""), "\", ""), ":", ""), "*", ""), "<", ""), ">", ""), "|", ""), """", "")
Dim path As String
path = ActivePresentation.path
If Len(Dir(path & "\" & packName & " Slide Pack - " & Title & ".pptx")) > 0 Then 'File exists
' If MsgBox("This will produce a pack in a separate PowerPoint file. Before extracting the pack make sure you have implemented a version number otherwise your changes maybe overwritten." & vbCrLf & vbCrLf & "Your current file will remain open, and any pending changes will not be automatically saved.", vbOKCancel, "Slide Manager - Create Pack") = vbOK Then
MsgBox ("File exists, the file name version number will be incremented")
CopySlidesToBlankPresentation packName
Application.ActivePresentation.SaveAs path & "\" & packName & " Slide Pack - " & Title & Count + 1, ppSaveAsOpenXMLPresentation
ActivePresentation.Save
Else
MsgBox ("This will produce a pack in a separate PowerPoint file." & vbCrLf & vbCrLf & "Your current file will remain open, and any pending changes will not be automatically saved")
CopySlidesToBlankPresentation packName
Application.ActivePresentation.SaveAs path & "\" & packName & " Slide Pack - " & Title, ppSaveAsOpenXMLPresentation
ActivePresentation.Save
End If
End Sub
Any help is greatly appreciated!
Regards,
Ben
If I understand your question correctly your loop should look something like this
Dim fileNoVersion As String
fileNoVersion = path & "\" & packName & " Slide Pack - " & Title
Dim count As Integer
count = 1
While Dir(fileNoVersion & count & ".pptx") <> ""
count = count + 1
Wend
This checks which files Version1, Version2, Version3... exist and returns the next unused number.