My VBA does the email merge wonderfully ... except, I have to click on "allow" - from Outlook - twice, for each email generated. Is there a way to programatically get around this?
I am running Windows 7 Enterprise, SP1. MS Office 2007. Computer is tightly locked down. HTML format e-mail not supported - only plain text. I do not have local admin rights. I am not able to install additional add-ins or third party software, as I've found suggested numerous times.
Here is my working VBA:
Private Sub Send_Email_Merge()
Dim sDBPath As String
'Word variables
Dim oWD As Word.Application
Dim oDoc As Word.Document
Dim RecCount As Long
'Sanity check on how many e-mails to be sent
RecCount = DLookup("[Email Count]", "qry_EmailMerge_Count")
Debug.Print RecCount
Set oWD = CreateObject("Word.Application")
oWD.Visible = True
Set oDoc = oWD.Documents.Open("C:\MyTemp\MyDocs\MyEmailMerge.docx")
With oDoc.MailMerge
.MainDocumentType = wdFormLetters
sDBPath = "C:\MyTemp\MydBs\My_Engine.accdb"
.OpenDataSource Name:=sDBPath, _
SQLStatement:="SELECT * FROM [qry_E Mail Merge]"
End With
oWD.Activate
oWD.Documents.Parent.Visible = True
oWD.Application.WindowState = 1
oWD.ActiveWindow.WindowState = 1
With oDoc.MailMerge
.Destination = wdSendToEmail
.MailAddressFieldName = "Email Address"
.MailSubject = "Your Action Required"
.MailFormat = wdMailFormatPlainText
.Execute
End With
oWD.Activate
oWD.Documents.Parent.Visible = True
oWD.Application.WindowState = 1
oWD.ActiveWindow.WindowState = 1
oWD.ActiveDocument.Close
oWD.Quit
Set oWD = Nothing
Set oDoc = Nothing
End Sub
Any help is appreciated.
You can automate directly from Access. See How to automate Outlook from another program for more information. It describes all the required steps for automating Outlook from another applications.
Related
I've created an Outlook form with several bound controls. I would like one of the check boxes when checked to make two text areas and their labels visible, then not be visible if the check box is unchecked. The controls that I want to make visible have the initial state of not-visible. I'm stuck on the VBScript syntax. I've been using Sue Mosher's Outlook programming book, but I'm a newby and I'm not getting it. I'd appreciate any help with this. I'm using Outlook 2010 on a Windows 7 machine. Thanks!
Here's my code:
Sub Item_PropertyChange(byVal Name)
Set objInsp = Item.GetInspector
Set objPage = objInsp.ModifiedFormPages("Message")
Set ckWGC = objPage.Controls("ckWGC")
Set lblState = objPage.Controls("lblState")
Set WGCState = objPage.Controls("WGCState")
Set lblCountry = objPage.Controls("lblCountry")
Set WGCCountry = objPage.Controls("WGCCountry")
If ckWGC.Value = True Then
lblState.Visible = True
WGCState.Visible = True
lblCountry.Visible = True
WGCCountry.Visible = True
Else
lblState.Visible = False
WGCState.Visible = False
lblCountry.Visible = False
WGCCountry.Visible = False
End If
End Sub
You would want to handle the CheckBox.Change event to capture when the user has checked or unchecked it.
Private Sub CheckBox1_Change()
End Sub
I want to run a VBScript file silently, because it is just a part of a hidden script.
I'm using the VBScript to export automatically documents out of SAP, that is working perfectly, unless showing each step in the SAP-GUI.
The VBScript file is started in a PowerShell, where I already tried to hide the process like:
$vbsPDPPath = "$env:userprofile\AppData\Roaming\KPIReport"
$vbsPDPName = "SAP-ExportPDP.vbs"
$processNamePDP = $vbsPDPPath + "\" + $vbsPDPName
Start-Process $processNamePDP -WindowStyle Hidden
Didn't work out though.
I'm looking for a solution like in VBA, where you can just add:
Application.ScreenUpdating = False
Still have no idea how to solve it. I thought it would be helpful to let you see the vbs-code, there must be the fault.
I noticed that I haven't mentioned to hide the SAP GUI as well as the Excel Application.
Dim Number_PDP
Dim testNode
Dim WshShell
Dim profile
Set WshShell = WScript.CreateObject("WScript.Shell")
profile = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
'read XML file
Set xmlDoc = CreateObject("MSXML.DomDocument")
xmlDoc.Load profile & "\AppData\Roaming\KPIReport\DIS.xml"
For Each testNode In xmlDoc.selectNodes("/Reports/Report")
Number_PDP = testNode.SelectSingleNode("DIS_PDP").Text
'connect to SAP GUI
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
SapGuiAuto.Visible = false
'not working, thought it is possible to hide SAP
session.findById("wnd[0]").resizeWorkingPane 132,31,false
session.findById("wnd[0]/tbar[0]/okcd").text = "/n cv04n"
session.findById("wnd[0]").sendVKey 0
...
'cutted a couple of rows, just opens a document in Excel with SAP
'after SAP opens Excel I used this code to save the documents
set objExcel = getobject(,"Excel.Application")
if err.number<>0 then
err.clear
end if
'this part should be hidden as well, not working
objExcel.Visible = false
objExcel.ActiveWorkbook.SaveAs profile & "\AppData\Roaming\KPIReport\" & Number_PDP
objExcel.ActiveWorkbook.Close
objExcel.Quit
Next
I would use a workaround in both cases.
For example:
. . .
'session.findById("wnd[0]").resizeWorkingPane 132,31,false
session.findById("wnd[0]").iconify
. . .
and
. . .
'objExcel.Visible = false
objExcel.WindowState = 2
. . .
Regards,
ScriptMan
This code is in MS Access (2010) VBA, using the Redemption library with Microsoft Outlook 2010.
I had this process working before, but we recently had a Citrix upgrade that I guess reset something in my Outlook and now the process no longer works.
I have a folder of .msg files which are basically pre-made email templates with all the proper formatting, images, text, etc.
This is what I was doing before:
Dim outlookApp As Object, namespace As Object
Dim oItem, MyItem
Set outlookApp = CreateObject("Outlook.Application")
Set namespace = outlookApp.GetNamespace("MAPI")
namespace.Logon
Set MyItem = outlookApp.CreateItemFromTemplate(path_to_dot_msg_file)
'And then there are many calls like this:
MyItem.HTMLBody = Replace(MyItem.HTMLBody, "Dear Person,", "Dear " & name)
'...
Set safeItem = CreateObject("Redemption.SafeMailItem")
Set oItem = MyItem
safeItem.Item = oItem
'this next line displays the email, and as of this line, it looks correct
'safeItem.Display
'but as of this line, the issue occurs
safeItem.HTMLBody = "<p>This is an extra message that shows up before the .msg file</p>" & safeItem.HTMLBody
safeItem.Recipients.ResolveAll
safeItem.Send
Now when the email is sent, the .msg contents aren't present at all -- the only thing that shows up is the "extra message" that I prepended to the HTMLBody.
What do I need to change or update? Is this something I need to change in the code, or in my Outlook settings, etc?
Extra: body insertion:
Function insertStringBodyTag(htmlBody As String, stringToInsert As String)
Dim s As String
Dim i As Integer
s = htmlBody
i = InStr(1, s, "<body")
i = InStr(i, s, ">")
s = Left(s, i) & stringToInsert & Right(s, Len(s) - i)
insertStringBodyTag = s
End Function
'Called with safeItem.htmlBody = insertStringBodyTag(safeItem.htmlBody, prefix_string)
You cannot concatenate 2 HTML strings and expect a valid HTML string back - the two must be merged - find the position of the "<body"substring in the original HTML body, then find the positon of the following ">" (this way you take care of the body element with attributes), then insert your HTML string following that ">".
I have a code in Access where it will send an email to the person in charge when the user click on save button. The code will use Outlook.application to send the email.
The code works fine but if outlook is not setup (i.e. fresh install without any user account setup) then the my email code will get stuck until user reactivates Access to acknowledge the error.
Sub Send_Email()
Dim oApp As Outlook.Application
Dim oMail As MailItem
On Error GoTo MailErr
If IsNull(Email) Then
MsgBox "You do not have an email account! No email will be sent!" & vbNewLine & "Email updates will be sent to your supervisor!" Me.Email.Value = DLookup("[Email]", "tblEmployeeList", "EmpName = '" & Me.txtSupName & "'")
Else
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "IT Incident " & Me.ReqID & " has been created."
oMail.Subject = "Alert: New IT Incident"
oMail.to = Forms!MainForm!lblITAdminEmail.Caption
oMail.Send
Set oMail = Nothing
Set oApp = Nothing
End If
MailErr:
'MsgBox Err
If Err = 287 Then
AppActivate "Microsoft Access"
MsgBox "Error 287: Mail not sent! Pls contact IT/BI"
ElseIf Err <> 0 Then
MsgBox "Pls contact BI/IT admin! Error " & Err & " occured!"
End If
Set oMail = Nothing
Set oApp = Nothing
End Sub
Is there a way to use VBA to check if Outlook has been setup properly prior to running this code?
Assuming that you are using at least Outlook 2007; take a look at the DefaultProfileName property of your Outlook.Application Object. This will return an empty string if no profile has been created or if there is no default profile.
You could just check this, but I believe that it's possible that an Outlook profile could exist but no actual e-mail accounts are configured within it (for instance if the user aborted the set-up wizard part way through). In this instance you could look at the Accounts Object which includes a Count property. Obviously if this is 0 then you know there are no accounts configured within the profile.
A simple example of how you could implement this.
Dim oApp As Outlook.Application
Set oApp = Outlook.Application
If Not oApp.DefaultProfileName = "" Then
If oApp.Session.Accounts.Count > 0 Then
' Send the e-mail
End If
End If
Set oApp = Nothing
im trying to send an email from a VBScript, it will eventually be added into a currently working script as an else if (if this is possible).
im getting an error at line 23 character 32?
Dim outobj, mailobj
Dim strFileText
Dim objFileToRead
Set outobj = CreateObject("Outlook.Application")
Set mailobj = outobj.CreateItem(0)
strFileText = GetText("C:\test\test 2.txt")
With mailobj
.To = "user#user.com"
.Subject = "Testmail"
.Body = strFileText
.Display
End With
Set outobj = Nothing
Set mailobj = Nothing
End Sub
Function GetText(sFile as String) As String
Dim nSourceFile As Integer, sText As String
nSourceFile = FreeFile
Open sFile For Input As #nSourceFile
sText = Input$(LOF(1), 1)
Close
GetText = sText
End Function
what do i need to add to get line 23 to work and the script to finally do what i need it to, i have copied most of this script from elsewhere due to a sincere lack of VBscripting knowledge?
Take a look at the Using Automation to Send a Microsoft Outlook Message article. It provides a sample code and describes all the required steps for sending emails.
Try this: remove the GetText function entirely, and replace the line
strFileText = GetText("C:\test\test 2.txt")
with
Set fso = CreateObject("Scripting.FileSystemObject")
strFileText = fso.OpenTextFile("C:\test\test 2.txt").ReadAll