Automating Microsoft Outlook with VBA using the example of creating a mass mailing list
In this article, I would like to share the experience of automating office, routine tasks of sending messages to a group of clients.
So, actually, what is the question: it is necessary to send emails with an attachment to several dozen clients. In this case, there should be only one address in the recipient field, i.e. customers should not know about each other. In addition, it is not allowed to install additional software , such as MaxBulk Mailer and the like. We have only Microsoft Office at our disposal, and in this particular case, Microsoft Office 2013.
I describe, in my opinion, the most option - without the use of templates, drafts and formatting. For our purposes, we need Outlook (go to the VBA editor and add the module, also include “Microsoft Excel 15.0 Object Library” in Tools> References), a text file with a mailing list on the principle “one line-one address”, a text file with the letter body and files that will be sent as an attachment.
The general algorithm is as follows: we specify the data for the fields and generate letters, going through the recipients in a cycle.
Immediately, I note that this example is not some kind of perfected code that works with maximum efficiency with minimum sizes. But it works and copes with the declared functionality. Actually, I was just too lazy to send manually a few dozen letters, and I wrote this program, and then decided to share it. If anyone is interested, he can improve the code as much as you like.
VBA, by default, does not require a clear declaration of variables and their types. In principle, you can do without it. Therefore, some variables in the "episodic roles" are not described in the construction with Dim.
So, first we request the subject of the letter with the implementation of the check for cancellation.
Now the queue for the files with addresses and text letters. Here came the nuance. How to call the file selection dialog? I don’t even want to think about hard prescription. So you have to invent something. Many people use the option with Application.GetOpenFilename will not work, because in Outlook there is no such method. Tried to use API. The variant with “Private Declare PtrSafe Function GetOpenFileName Lib„ comdlg32.dll “...” did not work (PtrSafe due to the fact that Win7 system, x64). I did not give any errors, but nothing appeared on the call. Solutions on the Internet did not find. If someone tells you the solution, I will be grateful. Thus, I had to go around with the use of an Excel object. Application.
And now attachments. Here I used a dynamic array and the ability to select multiple dialogs.
Every time I created and deleted the fd object because it is easier to do than to clean it before the next call.
To get data from text files, I had to use a couple of additional functions. They are called this way:
In order to debug, I inserted such code
'Data control
As you can see, he is now commented out, but allows you to understand where what lies.
Now a small one, but the most important part is the generation of letters.
If desired, the .Send method can be replaced by .Save. Then the created letters will be in the Drafts folder.
Here is the complete code of the module "as is".
In this example, the ability to send simple letters is implemented. If you need to expand the possibilities, for example, make the text formatted, then you should move in the direction of Outlook.MailItem> GetInspector> WordEditor. This, to put it mildly, complicates the code, but allows using the formatted Word document as the source of the letter text.
You can also add processing for the “intentional” absence of any component letter. For example, implement sending without a topic, text or attachments. Now the refusal from one of these elements will lead to interruption of the procedure.
This code should, theoretically, also work in earlier versions of Microsoft Office. Only the link to the Excel library will be changed.
So, actually, what is the question: it is necessary to send emails with an attachment to several dozen clients. In this case, there should be only one address in the recipient field, i.e. customers should not know about each other. In addition, it is not allowed to install additional software , such as MaxBulk Mailer and the like. We have only Microsoft Office at our disposal, and in this particular case, Microsoft Office 2013.
I describe, in my opinion, the most option - without the use of templates, drafts and formatting. For our purposes, we need Outlook (go to the VBA editor and add the module, also include “Microsoft Excel 15.0 Object Library” in Tools> References), a text file with a mailing list on the principle “one line-one address”, a text file with the letter body and files that will be sent as an attachment.
The general algorithm is as follows: we specify the data for the fields and generate letters, going through the recipients in a cycle.
Immediately, I note that this example is not some kind of perfected code that works with maximum efficiency with minimum sizes. But it works and copes with the declared functionality. Actually, I was just too lazy to send manually a few dozen letters, and I wrote this program, and then decided to share it. If anyone is interested, he can improve the code as much as you like.
VBA, by default, does not require a clear declaration of variables and their types. In principle, you can do without it. Therefore, some variables in the "episodic roles" are not described in the construction with Dim.
So, first we request the subject of the letter with the implementation of the check for cancellation.
TxtSubj = InputBox(" ", "") If Len(Trim(TxtSubj)) = 0 Then Exit Sub End If Now the queue for the files with addresses and text letters. Here came the nuance. How to call the file selection dialog? I don’t even want to think about hard prescription. So you have to invent something. Many people use the option with Application.GetOpenFilename will not work, because in Outlook there is no such method. Tried to use API. The variant with “Private Declare PtrSafe Function GetOpenFileName Lib„ comdlg32.dll “...” did not work (PtrSafe due to the fact that Win7 system, x64). I did not give any errors, but nothing appeared on the call. Solutions on the Internet did not find. If someone tells you the solution, I will be grateful. Thus, I had to go around with the use of an Excel object. Application.
Dim xlApp As New Excel.Application Set fd = xlApp.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Title = " " .Filters.Add " ", "*.txt", 1 If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Path2Body = vrtSelectedItem Next vrtSelectedItem Else Exit Sub End If End With Set fd = Nothing And for another file
Set fd = xlApp.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Title = " " .Filters.Add " ", "*.txt", 1 If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Path2To = vrtSelectedItem Next vrtSelectedItem Else Exit Sub End If End With Set fd = Nothing And now attachments. Here I used a dynamic array and the ability to select multiple dialogs.
Code
Set fd = xlApp.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = True .Title = ", " .Filters.Add " ", "*.*", 1 If .Show = -1 Then i = 0 ReDim Preserve Path2Att(i) For Each vrtSelectedItem In .SelectedItems Path2Att(i) = vrtSelectedItem i = i + 1 ReDim Preserve Path2Att(i) Next vrtSelectedItem Else Exit Sub End If End With Set fd = Nothing Every time I created and deleted the fd object because it is easier to do than to clean it before the next call.
To get data from text files, I had to use a couple of additional functions. They are called this way:
txtBody = ReadTXTfile(Path2Body) Item2To = ReadTXTfile2Arr(Path2To) And then their source code
Function ReadTXTfile(ByVal filename As String) As String Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close Set ts = Nothing: Set FSO = Nothing End Function Function ReadTXTfile2Arr(ByVal filename As String) As Variant Const OpenFileForReading = 1 Const OpenFileForWriting = 2 Const OpenFileForAppending = 8 Const vbSplitAll = -1 Dim S As Variant Set FSO = CreateObject("Scripting.FileSystemObject") Set FSOFile = FSO.GetFile(filename) Set TextStream = FSOFile.OpenAsTextStream(OpenFileForReading) Do While Not TextStream.AtEndOfStream S = S & TextStream.ReadLine & vbNewLine Loop TextStream.Close ReadTXTfile2Arr = Split(S, vbNewLine, vbSplitAll, vbTextCompare) Set TextStream = Nothing Set FSOFile = Nothing Set FSO = Nothing End Function In order to debug, I inserted such code
'Data control
'Debug.Print " " 'Debug.Print "-----------------" 'For i = 0 To UBound(Item2To) - 1 ' Debug.Print Item2To(i) 'Next i 'Debug.Print " " 'Debug.Print "-----------------" 'For i = 0 To UBound(Path2Att) - 1 ' Debug.Print Path2Att(i) 'Next i 'Debug.Print " " 'Debug.Print "-----------" 'Debug.Print TxtSubj 'Debug.Print " " 'Debug.Print "-----------" 'Debug.Print txtBody As you can see, he is now commented out, but allows you to understand where what lies.
Now a small one, but the most important part is the generation of letters.
Dim olMailMessage As Outlook.MailItem For i = 0 To UBound(Item2To) - 1 Set olMailMessage = Application.CreateItem(olMailItem) With olMailMessage DoEvents .To = Item2To(i) .Subject = TxtSubj .Body = txtBody For k = 0 To UBound(Path2Att) - 1 .Attachments.Add Path2Att(k), olByValue DoEvents Next k .Send End With Set olMailMessage = Nothing Next i If desired, the .Send method can be replaced by .Save. Then the created letters will be in the Drafts folder.
Here is the complete code of the module "as is".
Code
Attribute VB_Name = "Module" Function ReadTXTfile(ByVal filename As String) As String Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close Set ts = Nothing: Set FSO = Nothing End Function Function ReadTXTfile2Arr(ByVal filename As String) As Variant Const OpenFileForReading = 1 Const OpenFileForWriting = 2 Const OpenFileForAppending = 8 Const vbSplitAll = -1 Dim S As Variant Set FSO = CreateObject("Scripting.FileSystemObject") Set FSOFile = FSO.GetFile(filename) Set TextStream = FSOFile.OpenAsTextStream(OpenFileForReading) Do While Not TextStream.AtEndOfStream S = S & TextStream.ReadLine & vbNewLine Loop TextStream.Close ReadTXTfile2Arr = Split(S, vbNewLine, vbSplitAll, vbTextCompare) Set TextStream = Nothing Set FSOFile = Nothing Set FSO = Nothing End Function Public Sub Autosender() ' ( ), ' ' ( ) Dim Path2Body As String Dim Path2To As String Dim Path2Att() As String Dim Item2To() As String Dim TxtSubj As String Dim txtBody As Variant Dim i Dim k Dim vrtSelectedItem As Variant Dim fd As FileDialog Dim olMailMessage As Outlook.MailItem Dim xlApp As New Excel.Application GenerateThis = False TxtSubj = InputBox(" ", "") If Len(Trim(TxtSubj)) = 0 Then Exit Sub End If Set fd = xlApp.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Title = " " .Filters.Add " ", "*.txt", 1 If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Path2Body = vrtSelectedItem Next vrtSelectedItem Else Exit Sub End If End With Set fd = Nothing Set fd = xlApp.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Title = " " .Filters.Add " ", "*.txt", 1 If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Path2To = vrtSelectedItem Next vrtSelectedItem Else Exit Sub End If End With Set fd = Nothing Set fd = xlApp.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = True .Title = ", " .Filters.Add " ", "*.*", 1 If .Show = -1 Then i = 0 ReDim Preserve Path2Att(i) For Each vrtSelectedItem In .SelectedItems Path2Att(i) = vrtSelectedItem i = i + 1 ReDim Preserve Path2Att(i) Next vrtSelectedItem Else Exit Sub End If End With Set fd = Nothing Set xlApp = Nothing txtBody = ReadTXTfile(Path2Body) Item2To = ReadTXTfile2Arr(Path2To) DoEvents ' 'Debug.Print " " 'Debug.Print "-----------------" 'For i = 0 To UBound(Item2To) - 1 ' Debug.Print Item2To(i) 'Next i 'Debug.Print " " 'Debug.Print "-----------------" 'For i = 0 To UBound(Path2Att) - 1 ' Debug.Print Path2Att(i) 'Next i 'Debug.Print " " 'Debug.Print "-----------" 'Debug.Print TxtSubj 'Debug.Print " " 'Debug.Print "-----------" 'Debug.Print txtBody For i = 0 To UBound(Item2To) - 1 Set olMailMessage = Application.CreateItem(olMailItem) With olMailMessage DoEvents .To = Item2To(i) .Subject = TxtSubj .Body = txtBody For k = 0 To UBound(Path2Att) - 1 .Attachments.Add Path2Att(k), olByValue DoEvents Next k .Send End With Set olMailMessage = Nothing Next i MsgBox ".", vbInformation + vbOKOnly, "" End Sub In this example, the ability to send simple letters is implemented. If you need to expand the possibilities, for example, make the text formatted, then you should move in the direction of Outlook.MailItem> GetInspector> WordEditor. This, to put it mildly, complicates the code, but allows using the formatted Word document as the source of the letter text.
You can also add processing for the “intentional” absence of any component letter. For example, implement sending without a topic, text or attachments. Now the refusal from one of these elements will lead to interruption of the procedure.
This code should, theoretically, also work in earlier versions of Microsoft Office. Only the link to the Excel library will be changed.
')
Source: https://habr.com/ru/post/185568/
All Articles