supabribri
New member
- Local time
- Yesterday, 21:05
- Joined
- Mar 30, 2013
- Messages
- 1
sorry to sound like a fool.. but where in the code do I put the "<subject>" or excel data field?
In Word, the "<<subject>>" data field is added directly on your word document, not in the code.
It's been a long time since I used merge but if you still need help, just let us know.
""
i = .DataSource.DataFields.Count
Do While i > 0
.MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare)
i = i - 1
Loop
End With
""
""
i = .DataSource.DataFields.Count
Do While i > 0
.MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare)
i = i - 1
Loop
Set objNewMail.bcc = CreateObject("CDONTS.NewMail".bcc)
objNewMail.Send "user2@example.com", "user1@example.com", "Hello", _
"I sent this in 3 statements!", 0 ' low importance
Set objNewMail = Nothing
End With
""
If you have access to an SMTP server (gmail even), then you can use the CDONTS library. There are plenty of examples floating around. Check the code repository. In this case, your email code would probably go right after the 'Loop' tag, before the 'End With'. If sending large batches through Gmail, beware of their Sending Limits.
Function SendMail(strTo, strFrom, strSubject, strBody, msgType)
Set objCDOConf = CreateObject("CDO.Configuration")
With objCDOConf
' ** OUT GOING SMTP SERVER **
.Fields("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "ExchServerName"
' ** SMTP PORT **
.Fields("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
' ** CDO PORT **
.Fields("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
' ** TIMEOUT **
.Fields("[URL]http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout[/URL]") = 60
.Fields.Update
End With
Set objMail = CreateObject("CDO.Message")
Set objMail.Configuration = objCDOConf
objMail.To = strTo
objMail.From = strFrom
objMail.Subject = strSubject
'bcc me to check emails are sent
objMail.Bcc = [EMAIL="somebody@somewhere.com"]somebody@somewhere.com[/EMAIL]
If msgType = TEXTMSG Then
objMail.TextBody = strBody
Else
objMail.htmlBody = strBody
End If
objMail.Fields.Update
objMail.Send
Set objMail = Nothing
End Function
For anyone else looking for the answer Try:
This will intercept Mail Merge requests and parse the subject line for merge fields. Just put chevrons round the name of the Merge Field.Code:Dim WithEvents wdapp As Application Dim EMAIL_SUBJECT As String Dim FIRST_RECORD As Boolean Private Sub Document_Open() Set wdapp = Application ThisDocument.MailMerge.ShowWizard 1 End Sub Private Sub Document_Close() Set wdapp = Nothing End Sub Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean) Dim i As Integer With ActiveDocument.MailMerge If FIRST_RECORD = True Then EMAIL_SUBJECT = .MailSubject FIRST_RECORD = False Else .MailSubject = EMAIL_SUBJECT End If i = .DataSource.DataFields.Count Do While i > 0 .MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare) i = i - 1 Loop End With End Sub Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean) FIRST_RECORD = True End Sub Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document) ActiveDocument.MailMerge.MailSubject = EMAIL_SUBJECT End Sub
e.g. "Reference Request for <Applicant_Name>"
You can find Merge Field names by using them in your document and pressing Alt+F9.
This only works if you initiate the Mail Merge via the task pane and not if you use the Toolbar button.
Public WithEvents wdapp As Word.Application
Dim ORIG_EMAIL_SUBJECT As String
Dim FIRST_RECORD As Boolean
Dim SUBJ_VAR As String
Dim COL_NUM As Integer
Private Sub Document_Open()
Set wdapp = Application
ThisDocument.MailMerge.ShowWizard 1
End Sub
Private Sub Document_Close()
Set wdapp = Nothing
End Sub
Public Function extract_value(str As String) As String
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As String
On Error Resume Next
openPos = InStr(str, "<")
On Error Resume Next
closePos = InStr(str, ">")
On Error Resume Next
midBit = Mid(str, openPos + 1, closePos - openPos - 1)
If openPos <> 0 And Len(midBit) > 0 Then
extract_value = midBit
Else
extract_value = "NO VARIABLE FOUND"
End If
End Function
Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
'Called once per record (row in spreadsheet).
With ActiveDocument.MailMerge
'Get or reset the .MailSubject MailMerge property
If FIRST_RECORD = True Then
ORIG_EMAIL_SUBJECT = .MailSubject
FIRST_RECORD = False 'Set the flag so it won't change the ORIG_EMAIL_SUBJECT anymore
SUBJ_VAR = extract_value(.MailSubject) 'SUBJ_VAR is the what I want to extract from the subject line and change - this is input in MailMerge Wizard in angle brackets "< >"
Else:
.MailSubject = ORIG_EMAIL_SUBJECT 'Reset from customized .MailSubject back to original for next mailmerge iteration
End If
'Updated for Office 2013 Object model. I have not tested on Office 2010 object model.
.MailSubject = Replace(.MailSubject, "<" & SUBJ_VAR & ">", .DataSource.DataFields(SUBJ_VAR).Value, , , vbTextCompare)
End With
End Sub
Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean)
'Initialize for first use
FIRST_RECORD = True
End Sub
Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
'Reset back to original when done.
ActiveDocument.MailMerge.MailSubject = ORIG_EMAIL_SUBJECT
End Sub
For anyone else looking for the answer Try:
This will intercept Mail Merge requests and parse the subject line for merge fields. Just put chevrons round the name of the Merge Field.Code:Dim WithEvents wdapp As Application Dim EMAIL_SUBJECT As String Dim FIRST_RECORD As Boolean Private Sub Document_Open() Set wdapp = Application ThisDocument.MailMerge.ShowWizard 1 End Sub Private Sub Document_Close() Set wdapp = Nothing End Sub Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean) Dim i As Integer With ActiveDocument.MailMerge If FIRST_RECORD = True Then EMAIL_SUBJECT = .MailSubject FIRST_RECORD = False Else .MailSubject = EMAIL_SUBJECT End If i = .DataSource.DataFields.Count Do While i > 0 .MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare) i = i - 1 Loop End With End Sub Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean) FIRST_RECORD = True End Sub Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document) ActiveDocument.MailMerge.MailSubject = EMAIL_SUBJECT End Sub
e.g. "Reference Request for <Applicant_Name>"
You can find Merge Field names by using them in your document and pressing Alt+F9.
This only works if you initiate the Mail Merge via the task pane and not if you use the Toolbar button.
If you have access to an SMTP server (gmail even), then you can use the CDONTS library. There are plenty of examples floating around. Check the code repository. In this case, your email code would probably go right after the 'Loop' tag, before the 'End With'. If sending large batches through Gmail, beware of their Sending Limits.
For anyone else looking for the answer Try:
This will intercept Mail Merge requests and parse the subject line for merge fields. Just put chevrons round the name of the Merge Field.Code:Dim WithEvents wdapp As Application Dim EMAIL_SUBJECT As String Dim FIRST_RECORD As Boolean Private Sub Document_Open() Set wdapp = Application ThisDocument.MailMerge.ShowWizard 1 End Sub Private Sub Document_Close() Set wdapp = Nothing End Sub Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean) Dim i As Integer With ActiveDocument.MailMerge If FIRST_RECORD = True Then EMAIL_SUBJECT = .MailSubject FIRST_RECORD = False Else .MailSubject = EMAIL_SUBJECT End If i = .DataSource.DataFields.Count Do While i > 0 .MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare) i = i - 1 Loop End With End Sub Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean) FIRST_RECORD = True End Sub Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document) ActiveDocument.MailMerge.MailSubject = EMAIL_SUBJECT End Sub
e.g. "Reference Request for <Applicant_Name>"
You can find Merge Field names by using them in your document and pressing Alt+F9.
This only works if you initiate the Mail Merge via the task pane and not if you use the Toolbar button.