Cheers Jimboy,
That should work fine, but will it stay on-top while the code is opening Outlook and generating new mail items ?
Also, I have created the userform as described, but am not sure how I can incorporate this into my code . . . . which is below . . .
Cheers
Sub SubMileage()
'Declarations
Dim appOutlook As Object
Dim outMailItem As Object
Dim Created As Boolean
Dim MsgBoxAnswer As Variant
'User Confirmation
MsgBoxAnswer = MsgBox("Are you sure you wish to send the report?", vbYesNo + vbInformation, _
"Email Warning!!!!")
If MsgBoxAnswer <> vbYes Then Exit Sub
'Save document
ActiveWorkbook.SaveAs Filename:="C:\Mileage Return " & Format(Range ("$C$8"), "mmmm-yy")
'Generate mail item
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderOutbox)
Set outMailItem = myOlApp.CreateItem(olMailItem)
outMailItem.Display
If Created Then appOutlook.Quit
'Get info and send mail
Dim CCAddress As String
CCAddress = Application.WorksheetFunction.Substitute(Range("$E$2"), " ", ".") & "@bluestone.plc.uk"
With outMailItem
.CC = CCAddress
.Recipients.Add "la-la@tellietubbies.co.uk"
.Subject = Format(Range("$C$8"), "mmmm-yy") & " Mileage Return for " & Range("$c$5")
.Body = ActiveSheet.Range("$C$6") 'reg number (unique ID)
.Mileage = CStr(ActiveSheet.Range("$G$36")) ' Business Mileage for month
.BillingInformation = CStr(ActiveSheet.Range("$G$41")) 'Private Fuel Recharge
.Categories = CStr(ActiveSheet.Range("$C$8")) 'Month of return
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
Set MailItem = Nothing
If Created Then appOutlook.Quit
Set appOutlook = Nothing
'Check for IP connectivity, inform user accordingly
Dim IPAddress As String
If SocketsInitialize() Then IPAddress = GetIPFromHostName(GetPcName)
If Left(IPAddress, InStr(1, IPAddress, ".") - 1) = "10" Then
MsgBox "Message has been sent to: Bluestone Accounts" & vbNewLine & "and " & Range("$E$2")
Else
MsgBox "You are not connected to the network - The message HAS NOT yet been sent." & vbNewLine & "The message has been generated and saved in your E-mail Outbox." & vbNewLine & "It will be sent when you next connect to the network and open Microsoft Outlook E-Mail."
End If
SocketsCleanup
End Sub