I am importing data from Outlook. The code for opening Excel opens an instance where personal.xlsb is not loaded, and will open multiple instances of Excel. If I run it twice it will open two instances but will overwrite the data in the first instance, leaving the second instance with a blank workbook. If Excel is closed and Outlook is not, then the code is run it will give an error since it won't put the data into the new "second" instance, even though only one instance is running.
Sub Extract()
On Error GoTo 0
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim ThermoMail As Outlook.MailItem
Set ThermoMail = Application.ActiveInspector.CurrentItem
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add
'Set Headings
Dim msgText, delimtedMessage, Delim1 As String
delimtedMessage = ThermoMail.Body
'Remove everything before "Lead Source:" and after "ELMS"
TrimmedArray = Split(delimtedMessage, "Source:")
delimtedMessage = TrimmedArray(1)
TrimmedArray = Split(delimtedMessage, "ELMS")
delimtedMessage = TrimmedArray(0)
'Split the array at each return
messageArray = Split(delimtedMessage, vbCrLf)
'this next line gives the error if excel is closed and the macro is rerun.
Range("A1:A" & UBound(messageArray) + 1) = WorksheetFunction.Transpose(messageArray)
Call splitAtColons
End Sub
Right now, you are creating a new instance of Excel with this line:
Set xlobj = CreateObject("excel.application")
Excel is different than some (most) Office Applications, because it can run multiple instances (PowerPoint, Outlook, Word cannot do this...)
So what you want to do is first check if there is an open instance of Excel, and use that. Only create a new instance if there is no instance already open.
On Error Resume Next
Set xlObj = GetObject(, "Excel.Application")
On Error GoTo 0
If xlObj Is Nothing Then Set xlObj = CreateObject("Excel.Application")
Related
When I open Workbook and run this code everything is fine. Also if I close Workbook and open it again and run this code everything if functioning. However if I open Workbook and try to run this code for the second time then all Word operations are crushing. Word template is opened by code and even is saved to needed destination but it is not able to close Word document and gives an error:
Is there some variable or something in Windows memory still present after code has been executed because after closing and reopening Workbook everything works fine. Any ideas how to fix this?
Sub opentemplateWordOL()
Dim sh As Shape
Dim objWord As Object, objNewDoc As Object ''Word.Document
Dim objOL As OLEObject
Dim wSystem As Worksheet
'Application.ScreenUpdating = False
Set wSystem = ThisWorkbook.Sheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("OfferLetterTemplate")
''The OLE Object contained
Set objOL = sh.OLEFormat.Object
'Instead of activating in-place, open in Word
objOL.Verb xlOpen
'Set objWord = objOL.Object 'The Word document
Set objNewDoc = objOL.Object
Set objWord = objNewDoc.Application
Dim objUndo As Object 'Word.UndoRecord
'Be able to undo all editing performed by the macro in one step
Set objUndo = objWord.UndoRecord
objUndo.StartCustomRecord "Edit In Word"
With objNewDoc
'Cover page
.Bookmarks("CoverPageTitle").Range.Text = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
objNewDoc.SaveAs2 Environ$("Temp") & "\" & _
"MyFile" & ".docx"
objUndo.EndCustomRecord
objNewDoc.Undo
.Application.Quit False
End With
Set objWord = Nothing
Set objUndo = Nothing
Set sh = Nothing
Set wSystem = Nothing
Set objNewDoc = Nothing
'Application.ScreenUpdating = True
End Sub
You can check how this behaves on my computer here: https://streamable.com/2xd8k
You can see (by time of creation of file) that it is getting overwritten every time even when there is an error.
So for background, I get a excel workbook from another department that is full of a information for a specific account that I then take and use certain parts to create graphs in word. Is there a way I could create a macro what would grab the data from Ex. C22:H34, put it into a template word document and possibly auto populate the graphs as well? I want to make it a process that I can hand off to other people to do, so the simpler it is to execute, the better.
Here is what I have
Sub AutoNew()
'
' AutoNew Macro
'
'
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim bstartApp As Boolean
Dim i As Long
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open("C:\Users\MattsonC\Documents\work\Copy of
3202_2018_Renewal Rate Workbook v2 EDIT.xlsx")
Set xlsheet = xlbook.Sheets(1)
With xlsheet.Range("A1")
For i = 1 To .CurrentRegion.Rows.Count - 1
ActiveDocument.Variables(.Offset(i, 0)).Value = .Offset(i, 2)
Next i
End With
xlbook.Close
If bstartApp = True Then
xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
ActiveDocument.Range.Fields.Update
End Sub
I have variables done like {DOCVARIABLE LLY} in all the places I want data to go in the template, and renamed the cells in excel with the same variable name.
I can't get any output to happen in my Word document, any suggestions?
Thank you!
go back to the beginning
insert a document variable in a new word document using following sequence (word 2016)
insert tab … text … quick parts … field … categories: document automation … field names: docVariable … put in variable name xxxx
then run this code
Sub aaa()
'ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes ' toggle field code view
Stop
ActiveWindow.View.ShowFieldCodes = True
Stop
ActiveWindow.View.ShowFieldCodes = False
ActiveDocument.Variables("xxxx").Value = "abc123"
ActiveDocument.Range.Fields.Update
Stop
ActiveDocument.Variables("xxxx") = "xyz987"
ActiveDocument.Fields.Update
End Sub
if that works, then use the code with the document that you are having trouble with and figure out if your field names are what you think they are
I'm writing a macro in Access that (hopefully) will:
create an Excel worksheet
set up and format it based on information in the Access database
after user input, will feed entered data into an existing Excel master file
Opening the blank sheet etc. is working absolutely fine, but I'm stuck trying to set the existing master file up as a variable:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim wbXLname As String
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
wbXLname = "G:\[*full reference to file*].xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
'separate function (Boolean), using 'attempt to open file and lock it' method
'from Microsoft site.
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
'open file and set as variable.
ElseIf IsWBOpen = True Then
wbXLcore = appXL.Workbooks("ResultsOverall.xlsm") 'ERROR HERE.
'file is already open, so just set as variable.
End If
Debug.Print wbXLcore.Name
Debug.Print IsWBOpen
Set appXL = Nothing
End Sub
When the file is closed, this works perfectly. However, when it's open I get:
Run-Time error '9':
Subscript out of range
I'm only just starting to teach myself VBA (very trial and error!) and nothing else I've seen in answers here / Google quite seems to fit the problem, so I'm a bit lost...
Considering that it works fine when the file is closed, I suspect I've just made some silly error in referring to the file - perhaps something to do with the 'createobject' bit and different excel instances??
Any suggestions would be much appreciated! Thanks
Thank you #StevenWalker
Here's the working code:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew As Excel.Workbook, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
On Error GoTo Handler
Set appXL = GetObject(, "Excel.Application")
appXL.Visible = True
Dim wbXLname As String
wbXLname = "G:\ [...] .xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
ElseIf IsWBOpen = True Then
Set wbXLcore = appXL.Workbooks("ResultsOverall.xlsm")
End If
Set appXL = Nothing
'-------------------Error handling------------------
Exit Sub
' For if excel is not yet open.
Handler:
Set appXL = CreateObject("Excel.Application")
Err.Clear
Resume Next
End Sub
Sorry I'm on my phone so I can't go in to too much detail or do much with the code but at a glance I think you might need to add an error handler so that if the file is already open, a different line of code is executed.
Add 'On error go to handler' (before creating the excel object) and at the bottom
Of your code add 'handler:'. In the error handler, use get object rather than create object.
You will have to ensure you use exit sub before the error handler or it will run the handler every time you run the code.
You can see an example of what I mean here: How to insert chart or graph into body of Outlook mail
Although please note in this example it's the other way round (if error 'getting' outlook, then create it).
Example in link:
Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(olMailItem)
rest of code here
Exit Sub
'If Outlook is not open, open it
Handler:
Set myOutlook = CreateObject("Outlook.Application")
Err.Clear
Resume Next
End sub
If you move the appXL.Workbooks statement to the debugging window, you will find that the names of the items in that collection are without extension.
So in your case, I'm guessing the line should read:
wbXLcore = appXL.Workbooks("ResultsOverall")
I made a wizard button on a Access form where you can transfer the data of a Query to a new excel file and then the new file will automatically open.
Is there a way to make a reference to this new file or Sheet, because i want to put something in this new file.
This will get an open instance of Excel if it exists or create one if there isn't one.
Public Function GetExcelApp() As Excel.Application
' Returns open excel instance.
' If it doesn't exist, creates one to return
On Error GoTo ErrHandler
Const PROC_NAME As String = "GetExcelApp"
Const ERR_APP_NOTRUNNING As Long = 429
Set GetExcelApp = GetObject(, "Excel.Application")
CleanExit:
Exit Function
ErrHandler:
If Err.Number = ERR_APP_NOTRUNNING Then
Set GetExcelApp = CreateObject("Excel.Application")
Else
Err.Raise Err.Number, GetErrorSource(PROC_NAME), Err.Description & vbNewLine & "Unable to get instance of Excel.", Err.HelpFile, Err.HelpContext
End If
End Function
I keep this code in an XLHelper class and use it like this.
Dim helper As New XLHelper
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set xl = helper.GetExcelApp
Set wb = xl.Workbooks.Add
Set ws = wb.Worksheets.Add
To get the reference of the new sheet/workbook, you just set it equal to the results of the collection's Add method.
This works because Workbook.Add and Worksheets.Add return the object they create.
after searching multiple things, and getting errors
How do I upon pressing "f5" in a vba script copy the body of an email into an excel sheet /csv
where every line = a new cell below.
Thanks
Sorry, this is causing me nothing but trouble.
What I have tried so far
http://smallbusiness.chron.com/export-outlook-emails-excel-spreadsheets-41441.html
How to copy Outlook mail message into excel using VBA or Macros
http://www.vbforums.com/showthread.php?415518-RESOLVED-outlook-the-macros-in-this-project-are-disabled
http://www.ozgrid.com/forum/showthread.php?t=181512
and a few more, last year.
This will work for you. we are basically splitting the email body into an array based on a new line. Notice that this will yield blank cells if you had a blank line in the email body.
Public Sub SplitEmail() ' Ensure reference to Word and Excel Object model is set
Dim rpl As Outlook.MailItem
Dim itm As Object
Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.Reply
rpl.BodyFormat = olFormatHTML
'rpl.Display
End If
Dim objDoc As Word.Document
Set objDoc = rpl.GetInspector.WordEditor
Dim txt As String
txt = objDoc.Content.text
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
Dim wb As Excel.Workbook
Set wb = xlApp.Workbooks.Add
Dim i As Long
For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
wb.Worksheets(1).Range("A" & i + 1).Value = Split(txt, Chr(13))(i)
Next i
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
End Function
The Outlook object model doesn't recognize lines in the body. You can try to resize any inspector window in Outlook and see how the body lines are changed.
Anyway, you may try to use the Word object model to get the exact lines. Outlook uses Word as an email editor. The WordEditor property of the Inspector class returns an instance of the Document class which represents the message body. You can read more about all possible ways in the Chapter 17: Working with Item Bodies article.
The How to automate Microsoft Excel from Visual Basic article explains how to automate Excel from any external application.