My codes run fine until I get to closing the workbook. Here's my code:
.....
With olMail
.Subject = "Hi " & ActiveWorkbook.Name
.Body = strSubject
.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
.display
End With
Set olApp = Nothing
Set olNameSpace = Nothing
Set olMail = Nothing
Application.ScreenUpdating = True
ActiveWorkbook.Save
ActiveWorkbook.Saved = True
DoEvents
ActiveWorkbook.Close <<<<===== I see the BLANK EXCEL WINDOW HERE!
Application.EnableEvents = True
Exit Sub
I'm not sure if this is a bug with excel 2016 or not but this is the whole window of excel, it is missing the ribbon:
It's because you close the workbook and not the application.
Use Application.Quit
Related
I am taking a worksheet from a master workbook and creating a separate workbook for each one
These workbooks are then saved into a folder and then each workbook is added to an e-mail.
Each workbook is creating 2 e-mails but I can't see why from the code?
Sub MoveandSaveWorkBooks()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wK As Worksheet
For Each wK In ThisWorkbook.Worksheets
If wK.name = "Master Data" Then
ElseIf wK.name = "Button" Then
Else
wK.Copy
Selection.RowHeight = 84.75
Cells.EntireColumn.AutoFit
ActiveWorkbook.Password = UserInput
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & wK.name & ".xlsx"
Dim OlApp As Object
Dim NewMail As Object
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Attachments.Add ActiveWorkbook.FullName
.display
End With
On Error GoTo 0
Set NewMail = Nothing
Set OlApp = Nothing
ActiveWorkbook.Close True
End If
Next wK
Application.DisplayAlerts = True
Application.ScreenUpdating = True
I have a workbook that I am trying to email with macros. This way the recipient will also be able to use the macros that are included with the workbook. This will make office life easier for my company. I have tried setting the saved file name to .xlsm, but that causes an error.
This is my code (which is adapted from sources online)
Sub MailGo()
'Variable declaration
Dim oApp As Object, _
oMail As Object, _
WB As Workbook, _
FileName As String, MailSub As String, MailTxt As String
'Turns off screen updating
Application.ScreenUpdating = False
'Makes a copy of the active sheet and save it to
'a temporary file
ActiveSheet.Copy
Set WB = ActiveWorkbook
FileName = "Text.xls"
On Error Resume Next
Kill "C:\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:\Users\Public\Documents" & FileName
'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = "wesley.x.sherow#us.tel.com"
.Cc = ""
.Bcc = ""
.Subject = "LotInput"
.Body = "LotInput"
.Attachments.Add WB.FullName
.Display
.send
End With
'Deletes the temporary file
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
you need to also include this argument in your .SaveAs line.
FileFormat:=xlOpenXMLWorkbookMacroEnabled
I have a button and macro currently set up that allows a sheet to save to a folder and close that sheet. Is there a way I can add to the macro so it will email out a message from Outlook saying something along the lines of "machine checklist submitted" to Test123#outlook.com for example. Below is the code i already have that works a treat.
Sub Saveworkbook()
Application.DisplayAlerts = False
Dim Sheet1 As Worksheet
Dim dName$, vName$, sName$
dName = Range("B8")
vName = ActiveWorkbook.FullName
sName = ActiveWorkbook.ActiveSheet.Name
For Each Sheet1 In ActiveWorkbook.Sheets
If Not Sheet1.Name = sName Then
Sheet1.Delete
End If
Next Sheet1
ActiveWorkbook.SaveAs "\\filestore\IT$\Forms and Templates\Completed Checklists\" & dName & "_" & Environ("username") & "_" & Format(Now, "ddmmyy")
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
Thanks in advance
Sam
Add below to your code
dim olApp as object, olMail as object
set olApp = createobject("outlook.application")
set olMail = olApp.createitem(0)
With olMail
.To = "Test123#outlook.com"
.Cc = ""
.Bcc = ""
.Subject = "machine checklist submitted"
.body = "machine checklist submitted"
.Send
End With
set olApp = nothing
set olMail = nothing
I'm using the basic VBA code to send an email with a copy of my spreadsheet on a daily basis. The email subject is always the same.
I want these emails to appear in Outlook as the same conversation, so that they are nested/threaded when using Conversation view. However, these emails always come up as a new conversation.
How can I set a property in the OutMail variable below similar to .subject etc to create my own ConversationID / ConversationIndex that is always identical so that emails appear nested?
VBA code:
Dim Source As Range 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:AQ45").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = "C:\temp\"
TempFileName = "MyReport " & Format(Now, "yyyy-mm-dd hh-mm-ss")
FileExtStr = ".xlsx": FileFormatNum = 51
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
End With
With Dest
With OutMail
.to = "xyz#zyx.com"
.CC = ""
.BCC = ""
.Subject = "Subject Report 1"
.HTMLBody = RangetoHTML(Range("A1:AQ45"))
.Attachments.Add Dest.FullName
.Send
End With
End With
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
With Dest
On Error GoTo 0
.Close savechanges:=False
End With
This is the Outlook code that you can port over to Excel, using the method I suggest in the comments above.
Sub test()
Dim m As MailItem
Dim newMail As MailItem
Dim NS As NameSpace
Dim convo As Conversation
Dim cItem
Dim entry As String 'known conversationID property
Set NS = Application.GetNamespace("MAPI")
'Use the EntryID of a known item
'## MODIFY THIS BASED ON YOUR ENTRYID PROPERTY!! ##
entry = "0000000019EF3F5F49714748915AA379833C20460700D6CCDE850A3B9D41A5B930CCE1E12030000337DBD42F00003C7DFC9FAAF8254DACC71DEEEC1DF0A30003ADA9AF2D0000"
'Get a handle on this item:
Set m = NS.GetItemFromID(entry)
'Get a handle on the existing conversation
Set convo = m.GetConversation
'Get a handle on the conversation's root item:
Set cItem = convo.GetRootItems(1)
'Create your new email as a reply thereto:
Set newMail = cItem.Reply
'Modify the new mail item as needed:
With newMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Subject Report 1"
.HTMLBody = RangeToHTML(Range("A1:AQ45"))
.Attachments.Add Dest.FullName
.Display
'.Send
End With
End Sub
So the project I'm working, I have a VBS script that I automatically run daily using Windows Task Scheduler. The VBS script calls this macro. However, my email in Outlook always has a pop up that I can't get rid of (not an option in my org.). I also can't call the "Send" key object on the pop up because the objects are in an access restricted directory. So I'm trying to use send keys to simply send the enter key to hit the pop up.
My problem is that my code for sendkeys only partly works. It sends the enter key, but it only sends the enter key when I'm in an MS Office application, but it won't send to the pop up. Any ideas?
Sub Mail_ActiveSheet()
' Refreshes webquery
Application.Worksheets("Sheet1").Range("A1").QueryTable.Refresh BackgroundQuery:=False
' Enters Title Comments in Cell M2
Range("$M$2").Value = "Comments"
' Enters formula in column M
Range("$M$3").Formula = Range("G3") & (",") & Range("L3")
' Draws formula to the end of the workbook
Dim Lastrow As Long
Application.ScreenUpdating = False
Lastrow = Range("L" & Rows.Count).End(xlUp).Row
Range("M3:M" & Lastrow).Formula = "=G3&"",""&L3"
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim WshShell As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
' Next, copy the sheet to a new workbook.
' You can also use the following line, instead of using the ActiveSheet object,
' if you know the name of the sheet you want to mail :
' Sheets("Sheet5").Copy
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
' Determine the Excel version, and file extension and format.
With Destwb
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".csv": FileFormatNum = 6
Case 52:
If .HasVBProject Then
FileExtStr = ".csv": FileFormatNum = 6
Else
FileExtStr = ".csv": FileFormatNum = 6
End If
Case 56: FileExtStr = ".csv": FileFormatNum = 6
Case Else: FileExtStr = ".csv": FileFormatNum = 6
End Select
End With
' You can use the following statements to change all cells in the
' worksheet to values.
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Save the new workbook, mail, and then delete it.
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
' Change the mail address and subject in the macro before
' running the procedure.
With OutMail
.To = "myemail#gmail.com"
.CC = ""
.BCC = ""
.Subject = "Daily File"
.Body = "Daily File"
.Attachments.Add Destwb.FullName
' You can add other files by uncommenting the following statement.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
' Delete the file after sending.
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Wait (Now + TimeValue("0:00:04"))
ActiveWindow.Activate
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "~", True
WshShell.SendKeys ("{NUMLOCK}")
End Sub
I decided to remove the last block of code from my VBA macro and to create a VBScript to enter the send keys. In the end I have 2 VBScripts (one that calls my MACRO to run, then a second that runs my send key command). These VBScripts are both called from a batch (.bat) file.
This is the code I removed:
Application.Wait (Now + TimeValue("0:00:04"))
ActiveWindow.Activate
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "~", True
WshShell.SendKeys ("{NUMLOCK}")
Then this is what was placed in the sendkeys.vbs VBSCRIPT:
Set oShell = WScript.CreateObject("WScript.Shell")
WScript.Sleep 9000
oShell.SendKeys "{ENTER}"
Then this is my macro.vbs VBScript:
Set fso = CreateObject("Scripting.FileSystemObject")
curDir = fso.GetAbsolutePathName(".")
Set myxlApplication = CreateObject("Excel.Application")
myxlApplication.Visible = False
Set myWorkBook = myxlApplication.Workbooks.Open( "C:\Users\username\Desktop\macro.xlsm" ) 'Change to the actual workbook that has the Macro
myWorkBook.Application.Run "Module1.Mail_ActiveSheet" 'Change to the Module and Macro that contains your macro
myxlApplication.Quit
Then I just call both of those VBScripts from a batch file:
START C:\Users\username\Desktop\macro.vbs
START C:\Users\username\Desktop\sendkeys.vbs
Then all I have to do is run the batch file and it works like a charm.
Thanks for the suggestions!