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
Related
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
I was looking for a solution that would give me a Search Folder in Outlook where I could see emails that I flagged, but that I did not reply to/forward.
I searched the web. I didn't find a complete solution, so I glued one together and wanted to share.
I find it very useful, as sometimes I flag the email to work on it later, but it gets lost in between the rest of the flagged emails, where many I already replied to and flagged them just to remind myself I need an answer from the recipient.
This folder automatically searches for the most important emails I really need to answer.
This is what I find to work the best for me:
Sub create_all_not_replied_emails_search_folder()
'not replied flagged emails search folder
'credits https://www.extendoffice.com/documents/outlook/5591-outlook-create-search-folder-for-unreplied.html for giving me the basic idea
'credits to https://stackoverflow.com/users/4539709/0m3r for giving me idea of how to get flagged emails as answer at https://stackoverflow.com/a/43772304/10010199
'delcaring variables so the code is cleaner and compatible with Option Explicit
Dim strScope As String 'variable for Outlook Folder that will be searched
Dim strRepliedProperty As String 'variable for first MAPI property
Dim strRepliedProperty2 As String 'variable for second MAPI property
Dim strFilter As String 'variable for the whole filter
Dim objSearch As Outlook.Search 'variable for the search folder
'Specify the folders to be searched, here it is default inbox
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).FolderPath & "'"
strRepliedProperty = "http://schemas.microsoft.com/mapi/proptag/0x10810003" 'Search filter for unreplied emails. With the parameters not 102 and not 103 will get unreplied and not-forwared emails
strRepliedProperty2 = "http://schemas.microsoft.com/mapi/proptag/0x10900003" 'Sear filter for flagged emails. With parameters not 0 (not flagged) and not 1 (not finished) we get emails that are flagged, but are not finished yet
strFilter = Chr(34) & strRepliedProperty & Chr(34) & " <> 102" & "AND" & Chr(34) & strRepliedProperty & Chr(34) & " <> 103" & "AND" & Chr(34) & strRepliedProperty2 & Chr(34) & " <> 0" & " AND " & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x10900003" & Chr(34) & " <> 1" 'this is where the filter is set-up
Set objSearch = Outlook.Application.AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="SearchFolder") 'this is where the folder is created
'Save the search folder
objSearch.Save ("Not Replied Emails Dungeon") 'this is where the folder is saved with the name 'Not Replied Emails Dungeon'
MsgBox "Search folder is created successfully!", vbInformation + vbOKOnly, "Search Folder" 'Notify user that code finished
End Sub
I use the following VBA to open a message box:
Sub Message()
MsgBox ("Do you want create a file on your desktop?" _
& vbCr & " " _
& vbCr & "Once you click yes an unprotected file with all sheets visible will be saved on your desktop and opened. You can immediately start working with this file.")
End Sub
All this works fine.
However, as you can see in the screenshot the word "file" goes in a different line. Is it possible to format the messagebox or change the VBA code so the word "file" does not appear in a different line?
It depends on the resolution of the PC of the user. In my case I even get it like this:
If you want to control the lines, then you should write a custom form. There you would have much better control over the display, and if you play a bit with its properties, you would mimic exactly the MsgBox():
Some sample code, Label1 is a label element:
Private Sub UserForm_Initialize()
Me.Label1 = "Do you want create a file on your desktop?" _
& vbCr & " " _
& vbCr & "Once you click yes an unprotected file with all sheets visible will be saved on your desktop and opened." & _
vbCrLf & "You can immediately start working with this file."
End Sub
Perhaps adjust your code with line breaks to suit. For example:
Sub Message()
MsgBox ("Do you want create a file on your desktop?" _
& vbCr & " " _
& vbCr & "Once you click yes an unprotected file" _
& vbCr & " " _
& vbCr & "with all sheets visible will be saved on your desktop and opened." _
& vbCr & " " _
& vbCr & "You can immediately start working with this file.")
End Sub
I have written a VB.net executable that deletes a file then transfers a different one in it's place. An extract of the code is shown below. The problem is it fails every time due to the program that uses the file recreates it immediately after deletion.
How can I delete the file and prevent it being replaced? I cannot change anything about the program that's recreating it.
If IO.File.Exists(AMPDir & "AMP_DIR.DAT") = False Then
MsgBox("The following file is missing..." & vbCrLf & vbCrLf & " " & "AMP_DIR.DAT", MsgBoxStyle.Critical, "Error...")
Me.Close()
End
ElseIf IO.File.Exists(AMPDir & "AMP_DIR.DAT") = True And IO.File.Exists(LOGDir & "LOGIC.INF") = True Then
System.IO.File.Delete(AMPDir & "AMP_DIR.DAT")
System.IO.File.Copy(Path.GetDirectoryName(ConfigFile) & "\" & "AMP_DIR.DAT.IND", AMPDir & "AMP_DIR.DAT")
System.IO.File.SetAttributes(AMPDir & "AMP_DIR.DAT", FileAttributes.Normal)
End If
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.