The Word doc has a button with this VBA code that sends it to a specific email address in the to field and another email address in the CC field. The CC field needs to be populated by an address that was filled in on the Word document inside a Content Control Text Box though. How do I define that variable in the following VBA code:
Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xEmail As Object
Dim xDoc As Document
Application.ScreenUpdating = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
xDoc.Save
With xEmail
.Subject = "Click send"
.Body = "Click send"
.To = "sample#onmicrosoft.com"
.CC = "employee email from textBox control"
.Importance = olImportanceNormal
.Attachments.Add xDoc.FullName
.Display
End With
Set xDoc = Nothing
Set xEmail = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True
End Sub
Assuming it's the first text box in your document:
Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xEmail As Object
Dim xDoc As Document
Dim ccAddress As String 'Declare a string variable
Application.ScreenUpdating = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
ccAddress = xDoc.Shapes(1).TextFrame.TextRange.Text 'Store the textbox text in the variable
xDoc.Save
With xEmail
.Subject = "Click send"
.Body = "Click send"
.To = "sample#onmicrosoft.com"
.CC = ccAddress 'pass it to the CC property
.Importance = olImportanceNormal
.Attachments.Add xDoc.FullName
.Display
End With
Set xDoc = Nothing
Set xEmail = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True
End Sub
I would like to send the last page of a word document (162 pages long) using email. Currently I can send the whole document, but would like the last page that has the submit button to be the only thing sent.
I have tried changing the name to pge etc. I have little experience.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Insert Subject Here"
.Body = "I just want this to work already!!"
.To = "fakeemail#Idonotknowcode.ca"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
I have a form in word, whenever a submit is clicked upon it send a notification to email address and saves the file to a location. I have a script as below, I want when the data is input in the form and clicked on submit for 2nd time the saved file should have a different name because if the below script is run again it will overwrite the current form which is saved on that location.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
Doc.SaveAs2 "d:/abcd.docx"
With EmailItem
.Subject = "Test"
.Body = "Test"
.To = "jaiswalrohitkr#gmail.com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
You can use a global counter and the FileSystemObject to accomplish this.
'Global Variable to hold our iteration count
Public docCount As Integer
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Dim DocName As String
'add a reference to Microsoft Scripting Runtime
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
DocName = "d:/abcd.docx"
'use the fileSystemObject to check if the file already exists
Do While fso.FileExists(DocName) = True
DocName = "d:/abcd" & CStr(docCount) & ".docx"
'add one to the counter to check again
docCount = docCount + 1
Loop
Doc.SaveAs2 DocName
With EmailItem
If docCount > 0 Then
'more than one iteration so adjust name
.Subject = "Test" & CStr(docCount)
Else
'first iteration so leave it as test
.Subject = "Test"
End If
.Body = "Test"
.To = "jaiswalrohitkr#gmail.com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
I have created a 2010 Word doc with form fields and a command button to email the form. I did find code to close the doc after the email sent but, I need it to not save the changes before it closes the doc or clears the fields and uncheck the check boxes before it closes.
The goal is that they open a fresh form every time.
They are a contract company as well so I'm sending the form for them to save to their own drive, other wise I would have saved to our templates.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Medical/Psych router"
.To = "test#email.com"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Application.ActiveDocument.Close
End Sub
Try saving it to Temp Folder C:\Temp\, The Master Doc will be blank and you will have new file saved at C\Temp\ with file name Medical_Psych_router today's date Jun_18_2015. (Medical_Psych_router Jun_18_2015)
Option Explicit
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Dim sFileName As String
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
sFileName = "Medical_Psych_router " & Format(Now, "mmm_dd_yyyy")
Doc.SaveAs FileName:=("C:\Temp\") & sFileName, _
FileFormat:=wdFormatDocument, _
AddToRecentFiles:=True
'Doc.Save
With EmailItem
.Subject = "Medical/Psych router"
.To = "test#email.com"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Application.ActiveDocument.Close SaveChanges:=False
End Sub
So I have this code in Mcirosoft Outlook. The code runs when new mail comes in, and depending on the sender's name and the attachments, it saves the text files and imports the data into 2 access databases and and runs certain queries pre built in the database. The code errors out when 2 emails which are from the right sender and has the right attachments comes in. The code processes the first email correctly however when the second email is getting processed, the code errors out at the bolded line below.
Option Explicit
Private Sub Application_NewMail()
Dim ns As NameSpace
Dim inbox As MAPIFolder
Dim Item As MailItem
Dim atmt As Attachment
Dim fso As FileSystemObject
Dim fs As TextStream
Dim dt, invfn, misfn, invdr, misdr, dbfn As String
Dim invt, mist As Boolean
Dim db As Object
Set ns = GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
Set fso = New FileSystemObject
If inbox.UnReadItemCount = 0 Then
Exit Sub
Else
For Each Item In inbox.Items.Restrict("[UnRead] = True")
If Item.SenderName = "Menon, Jayesh" Then
dt = Left(Right(Item.Subject, 12), 10)
For Each atmt In Item.Attachments
If atmt.FileName = "InvalidLoans.txt" Then
invfn = "ERLMF_InvalidLoans_" & dt & ".txt"
invdr = "C:\Documents and Settings\U299482\Desktop\Data Drop\" & _
invfn
atmt.SaveAsFile invdr
Set fs = fso.OpenTextFile(invdr)
If fs.Read(23) = "Invalid Loans Count = 0" Then
invt = False
Else
invt = True
End If
fs.Close
End If
If atmt.FileName = "MissingLoans.txt" Then
misfn = "ERLMF_MissingLoans_" & dt & ".txt"
misdr = "C:\Documents and Settings\U299482\Desktop\Data Drop\" & _
misfn
atmt.SaveAsFile misdr
Set fs = fso.OpenTextFile(misdr)
If fs.Read(23) = "Missing Loans Count = 0" Then
mist = False
Else
mist = True
End If
fs.Close
End If
Next
If invt = True Or mist = True Then
Set db = CreateObject("Access.Application")
dbfn = "C:\Documents and Settings\U299482\Desktop\Databases\BPDashboard.accdb"
With db
.OpenCurrentDatabase dbfn, True
.Visible = True
If invt = True Then
.DoCmd.TransferText acImportDelim, "Lns_Spec", "Invalid_Lns", invdr, True
End If
If mist = True Then
.DoCmd.TransferText acImportDelim, "Lns_Spec", "Missing_Lns", misdr, True
End If
.Quit
End With
Set db = Nothing
End If
If invt = True Then
Set db = CreateObject("Access.Application")
dbfn = "C:\Documents and Settings\U299482\Desktop\Databases\CORE IDP.accdb"
With db
.OpenCurrentDatabase dbfn, True
.Visible = True
**CurrentDb.Execute "A0_Empty_ERLMF_InvalidLoans_2013-04-02", dbFailOnError**
.DoCmd.TransferText acImportDelim, "Lns_Spec", "ERLMF_InvalidLoans_2013-04-02", invdr, True
CurrentDb.Execute "AppendERLMF", dbFailOnError
CurrentDb.Execute "FaxRF Crystal Append", dbFailOnError
.Quit
End With
Set db = Nothing
End If
Item.UnRead = False
End If
Next
End If
End Sub
I think you're getting over-lapping .Execute commands. You need to ensure that the first execution finishes before starting the next. To fix, I'd start by declaring a Public variable Executing then move the below code into its own method.
Sub Execute()
Executing = True
Set db = CreateObject("Access.Application")
dbfn = "C:\Documents and Settings\U299482\Desktop\Databases\CORE IDP.accdb"
With db
.OpenCurrentDatabase dbfn, True
.Visible = True
CurrentDb.Execute "A0_Empty_ERLMF_InvalidLoans_2013-04-02", dbFailOnError
.DoCmd.TransferText acImportDelim, "Lns_Spec", "ERLMF_InvalidLoans_2013-04-02", invdr, True
CurrentDb.Execute "AppendERLMF", dbFailOnError
CurrentDb.Execute "FaxRF Crystal Append", dbFailOnError
.Quit
End With
Set db = Nothing
Executing = False
End Sub
Then, when calling the function, surround it with a loop that tests to see if Executing is false.
Do
If Executing = False Then
Execute
Exit Do
End If
Loop