I am producing a report which needs to be run daily. I have some pictures in Excel and I want to copy them and paste them into Word. I need them in a certain location. All this needs to be done in VBA.
My proposed way of doing this is by creating template pictures in Word and giving them a name (which can be seen in Home > Select > Selection Panel). I assume that I can then copy the pictures from Excel and paste them over the template pictures (i.e. replacing the template pictures) - I believe this type of technique is possible with Excel-Powerpoint.
(1) If I can execute this, will the pictures from Excel go to the right location in Word and be of the same dimensions as the template pictures?
(2) How do I select the existing named template pictures?
Here is my code so far but at the end, I am missing the ability to select the existing NAMED template pictures...
Dim wd As Object
Dim ObjDoc As Object
Dim FilePath As String
Dim FileName As String
FilePath = "OMITTED FOR PRIVACY REASONS"
FileName = "OMITTED FOR PRIVACY REASONS"
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
Else
On Error GoTo notOpen
Set ObjDoc = wd.Documents(FileName)
GoTo OpenAlready
notOpen:
Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
End If
OpenAlready:
On Error GoTo 0
wd.Visible = True
ObjDoc.
Thank you so much for your time and effort!
Related
I have been working on a spreadsheet where I want a VBA code to open a document, now this document could be either a word or excel document, but I want the code to use the information from a cell.
Function FnPrint()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("Y:\Master Documents\Sheet & Cut\W19-316 Allergen cleandown S&C line.docx")
objWord.Visible = True
objDoc.PrintOut
objWord.Quit
End Function
That is the code that I have, Now where it says "Y:\Master Documents\Sheet & Cut\W19-316 Allergen cleandown S&C line.docx", I want that to actually change depending on a certain cell, which you can see in the above image. This is because that cell changes depending on the variables entered in the other boxes.
Any Ideas?
..to open a document, now this document could be either a word or excel document
Logic:
Check the file extension of the file path in the cell and then decide whether you want to open Excel or Word.
Code (Untested):
Option Explicit
Sub Sample()
Dim rngDocInfo As Range
Dim objApp As Object, objDoc As Object
Dim myPath As String
'~~> Change this to relevant sheet and cell which has the path
Set rngDocInfo = Sheet1.Range("O18")
myPath = UCase(rngDocInfo.Value2)
If Len(Dir(myPath)) = 0 Then
MsgBox "Invalid filename. File does not exist"
Exit Sub
End If
'~~> Get file extension and check if it is an Excel document
If Right(myPath, Len(myPath) - InStrRev(myPath, ".")) Like "XLS*" Then
Set objApp = CreateObject("Excel.Application")
Set objDoc = objApp.Workbooks.Open(rngDocInfo.Value2)
objApp.Visible = True
'
' Rest of the code
'
'~~> Get file extension and check if it is a Word document
ElseIf Right(myPath, Len(myPath) - InStrRev(myPath, ".")) Like "DOC*" Then
Set objApp = CreateObject("Word.Application")
Set objDoc = objApp.Documents.Open(rngDocInfo.Value2)
objApp.Visible = True
'
' Rest of the code
'
Else
MsgBox "Unknown Document type"
End If
End Sub
Note: I am not handling Text/Csv Files in the above code. If you can have those file types then amend the above code accordingly.
The code below is intended to be used to copy a string from cells in an excel column sequentially (i=3 to 61), find a directory folder containing many copies of the same .doc file , and paste each string into the second row, first column of the first table in each .doc file.
Problem: The program un intentionally continues through loop and finishes running the rest of the code after executing the following line for the first time:
wddoc.Tables(1).Cell(2, 1).Range.Paste
This happens even though I am stepping into each line of code using F8 to reach this line of code. The code finishes running without having pasted anything into the remaining files in the directory. (The string in row 3 of the excel document was successfully pasted into plan template - Copy (10).docx but the remaining strings were not pasted into the remaining files)
The code:
Option Explicit
Sub CopyExcelToWord(path As String)
'variables----------------------------------------------------------------
'Decare Object variables for the Word application and file or documentl
Dim wdapp As Object, wddoc As Object, i As Integer
'Declare a String variable for the directory root and current file in that directory
Dim currentPath As String
'main process----------------------------------------------------------
'error handling is extremely important in making Excel work with Word
On Error Resume Next
'GetObject needs two parameters. The first is optional
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'we create a new instance of MS Word
Set wdapp = CreateObject("Word.Application")
End If
'Our application is made visible
wdapp.Visible = True
currentPath = Dir(path, vbDirectory)
For i = 3 To 61
Do Until currentPath = vbNullString
Debug.Print currentPath
If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
Debug.Print path & currentPath
Sheet1.Range(Cells(i, 2), Cells(i, 2)).Copy
'we activate our MS Word instance
wdapp.Activate
Set wddoc = wdapp.Documents(path & currentPath)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(path & currentPath)
wddoc.Activate
wddoc.Tables(1).Cell(2, 1).Range.Paste
'Free alocated memory and close
wdapp.Quit
Set wddoc = Nothing
Set wdapp = Nothing
'The following line of code removes the cell selection in Excel
Application.CutCopyMode = False
currentPath = Dir()
Else
currentPath = Dir()
End If
Loop
Next
End Sub
The print ( I have placed a '...' where I have omitted a section of the path ):
.
.
..
.
plan template - Copy (10).docx
L
C:**...**\ plan template - Copy (10).docx
The program runs through the rest of code unintentionally. The string in row 3 of the excel document was successfully pasted into plan template - Copy (10).docx and but the remaining strings were not pasted into the remaining files )
plan template Copy (11).docx
L
C:*...**\plan template - Copy (11).docx
Lesson plan template - Copy (12).docx
L
C:*...\plan template -Copy (12).docx
plan template - Copy (13).docx
L
C:**...\ plan template -
L
...
C:*...**\plan template - Copy (9).docx
Lesson plan template.docx
L
C:*...**\plan template.docx
I am not certain that fixing this will solve your problem, but you have
wddoc.Tables(1).Cell(2, 1).Range.Paste
'Free alocated memory and close
wdapp.Quit
Set wddoc = Nothing
Set wdapp = Nothing
Once you have done wdapp.Quit, you no longer have a wdapp, so in the next iteration of your "For i" loop, nothing will work.
But if you want to save your wddoc, you can't rely on Set wddoc = Nothing to do it. You need to do an explicit Close, or Save and Close
So e.g.
wddoc.Tables(1).Cell(2, 1).Range.Paste
wddoc.Close -1 ' SaveChanges:=Word.wdSaveOptions.wdSaveChanges
' Only do this outside your "For i =" loop
'Free alocated memory and close
'wdapp.Quit
Set wddoc = Nothing
' Only do this outside your "For i =" loop
' Set wdapp = Nothing
Your 'issue' is nothing to do with the paste command.
Your code sets all errors to be ignored, creates a Word application object, then enters a loop where:
a cell value is copied
a Word document is opened
the contents of the clipboard are pasted into a table cell in the Word document
Word is shut down and the application object destroyed
The first iteration of the loop will run successfully but subsequent iterations will error at each line that involves Word as the object no longer exists. Those errors are ignored because of On Error Resume Next.
What you need to do:
Reset error handling after the Word object has been obtained
Add a flag if Word wasn't open so that it can be shut down when operations are complete
Close the document and save the changes once it is finished with inside the loop
Move wdapp.quit outside the loop
As Word retains clipboard history and you are only copying the value of a single cell I would avoid using copy paste for this. Instead write the value directly to the table cell.
This is how I would write your code:
Option Explicit
Sub CopyExcelToWord(path As String)
'variables----------------------------------------------------------------
'Decare Object variables for the Word application and file or document
Dim wdapp As Object, wddoc As Object, i As Integer
'Declare a String variable for the directory root and current file in that directory
Dim currentPath As String
'declare flag to show if Word needs to be quit
Dim quitWord As Boolean
'main process----------------------------------------------------------
'error handling is extremely important in making Excel work with Word
On Error Resume Next
'GetObject needs two parameters. The first is optional
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'we create a new instance of MS Word
Set wdapp = CreateObject("Word.Application")
'as Word wasn't already open make application visible
wdapp.Visible = True
'set flag to show Word needs to be shut down
quitWord = True
End If
'reset error handling so that any subsequent errors aren't ignored
On Error GoTo 0
currentPath = Dir(path, vbDirectory)
For i = 3 To 61
Do Until currentPath = vbNullString
Debug.Print currentPath
If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
Debug.Print path & currentPath
Set wddoc = wdapp.Documents.Open(path & currentPath)
wddoc.Tables(1).Cell(2, 1).Range.Text = Sheet1.Range(Cells(i, 2), Cells(i, 2)).Value
'document no longer required so close and save changes
wddoc.Close -1 ' SaveChanges:=Word.wdSaveOptions.wdSaveChanges
Set wddoc = Nothing
currentPath = Dir()
Else
currentPath = Dir()
End If
Loop
Next
'Now that operations involving Word are complete quit Word if necessary and destroy objects
If quitWord Then wdapp.Quit
Set wdapp = Nothing
End Sub
I am trying to write some macros in both Excel and Outlook that in the end will automatically unzip and open a CSV, process the data, and sends it where it needs to go when a new email arrives in a specific folder. I have everything worked out on the Excel side but I am having difficulties with Outlook. The below code unzips the file. How would i go about opening the unzipped file and triggering an Excel macro (which is always open in another workbook)?
Another issue I am running into: this code only seems to work when i actually open the target email in it's own window.
Public Sub OpenZippedSheet()
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim objShell As Object
Dim objFileSystem As Object
Dim strTempFolder As String
Dim strFilePath As String
Dim strFileName As String
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
Set objAttachments = objMail.Attachments
'Save & Unzip the zip file in local drive
Set objShell = CreateObject("Shell.Application")
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp" & Format(Now, "yyyy-mm-dd-hh-mm-ss")
MkDir (strTempFolder)
For Each objAttachment In objAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.FileName
objAttachment.SaveAsFile (strFilePath)
objShell.NameSpace((strTempFolder)).CopyHere objShell.NameSpace((strFilePath)).Items
End If
Next
End Sub
I'm assuming I would do some sort of object.open but I don't know what the syntax would be to get it to actually open in Excel. And then is there a way to trigger an Excel macro from Outlook?
Thanks so much in advance!
this code only seems to work when i actually open the target email in it's own window.
That is because you rely on the ActiveInspector window. If you want to handle items selected in the Explorer windows you need to check the Selection object (see the corresponding property).
To open an Excel file you can:
Use the Shell.ShellExecute method. This method is equivalent to launching one of the commands associated with a file's shortcut menu. Each command is represented by a verb string. The set of supported verbs varies from file to file. The most commonly supported verb is "open", which is also usually the default verb. Other verbs might be supported by only certain types of files.
Automate Excel from your VBA macro to do the required actions. See How to automate Microsoft Excel from Visual Basic for more information.
To run your VBA macro code from other applications you can use the Application.Run method. Read more about that in the How do I use Application.Run in Excel article.
Application.Run "'" & TestWkbk.Name & "'!MacroNameHere", "parm1", "parm2"
Something like this (untested so may need some fixes):
'Note - any paths passed to objShell should be
' passed as *Variants*, not Strings
Dim oXL As Object, wbCSV As Object, fileNameInZip As Variant
Set objShell = CreateObject("Shell.Application")
For Each objAttachment In objAttachments
If Right(objAttachment.Filename, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.Filename
objAttachment.SaveAsFile strFilePath
Set oNS = oApp.Namespace(strFilePath)
For Each fileNameInZip In oNS.items 'loop over the files in the zip
Debug.Print fileNameInZip
If LCase(fileNameInZip) Like "*.csv" Then 'csv file?
'extract the file
objShell.Namespace(strTempFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
If oXL Is Nothing Then Set oXL = GetObject(, "Excel.Application") 'assumes excel is running
Set wbCSV = oXL.Workbooks.Open(strTempFolder & "\" & fileNameInZip)
oXL.Run "'YourMacroFile.xlsm'!YourMacroName" 'run the macro
'clean up stuff...
End If 'is a csv file
Next 'file in zip
End If 'attachment is a zip file
Next 'attachment
Hello and thank you for your answers in advance.
I am opening a word document using excel-vba and save it under a new name.
This is actually working fine.
But problems occur if the word document with the new name is already opened!
Let's say there is a button to run the script and the user runs it the second time, and has the created file still opened. The user might change something in excel and now wants to check how the new word document would look like afterwords. He will click the button again.
It will open the template (do all changes) and try to save it, but can't because it is already opened and it might save this document with the old name (template) instead of a new file. Therefor it will overwrite and destroy the template file (got this several times during testing)!
Therefore I am in need of some proper code and a better Error-Handling. My first thought is to check if the document with the filename already exists. But it does not quite do its job:
Sub CreateWordDocument()
Dim TemplName, CurrentLocation, DocumentName, Document As String
Dim WordDoc, WordApp, OutApp As Object
With table1
TemplName = table1.Range("A1").Value 'Get selected template name
CurrentLocation = Application.ActiveWorkbook.Path 'working folder
Template = CurrentLocation + "\" + TemplName
DocumentName = .Range("A2").Value
Document = CurrentLocation + "\" + DocumentName + ".docx"
'Open Word Template
On Error Resume Next 'if Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If
'if document is already opened in word than close it
'if its not possible to close it - end application to prevent any damage to the template
On Error GoTo notOpen
Set WordDoc = WordApp.Documents(DocumentName + ".docx")
On Error GoTo closeError
WordDoc.Close
notOpen:
'Open the template
Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False) 'Open Template
'save with new name
WordDoc.SaveAs Document
closeError:
'open a message box and tell user to close and run again.
At the current stage it just jumpes from "Set WordDoc = WordApp. ..." to notOpened. Any suggestions how to solve this issue?
Add this function:
Public Function FileIsOpen(FullFilePath As String) As Boolean
Dim ff As Long
On Error Resume Next
ff = FreeFile()
Open FullFilePath For Input Lock Read As #ff
Close ff
FileIsOpen = (Err.Number <> 0)
On Error GoTo 0
End Function
Then use in your code:
If Not FileIsOpen(DocumentName & ".docx") Then
Set WordDoc = WordApp.Documents.Open(Filename:=Template, ReadOnly:=False)
Else
'Do something else because the file is already open.
End If
The document name must be the full path to the document.
Couple of other things:
Only Document is a string, and OutApp is an object. All other variables are Variants.
Dim TemplName, CurrentLocation, DocumentName, Document As String
Dim WordDoc, WordApp, OutApp As Object
It should be:
Dim TemplName As String, CurrentLocation As String, DocumentName As String, Document As String
Dim WordDoc As Object, WordApp As Object, OutApp As Object
VBA generally uses + for addition, and & for concatenation.
DocumentName + ".docx"
would be better written as
DocumentName & ".docx"
Document is a reserved word in Word. It shouldn't cause too much problem here as the code is in Excel, but something to keep in mind.
In my excel document I have a chart that I want to copy and paste into a MS-Word document. I want to avoid linking data, embedding workbooks and resizing (Excel has the chart formatted to my desired size). So I came up with/found the following code that almost works:
Sub PasteChart()
Dim wd As Object
Dim ObjDoc As Object
Dim FilePath As String
Dim FileName As String
FilePath = "C:\Users\name\Desktop"
FileName = "Template.docx"
'check if template document is open in Word, otherwise open it
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
Else
On Error GoTo notOpen
Set ObjDoc = wd.Documents(FileName)
GoTo OpenAlready
notOpen:
Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
End If
OpenAlready:
On Error GoTo 0
'find Bookmark in template doc
wd.Visible = True
ObjDoc.Bookmarks("LPPU").Select
'copy chart from Excel
Sheets("Group Level Graphs").ChartObjects("Chart 1").Chart.ChartArea.Copy
'insert chart to Bookmark in template doc
wd.Selection.PasteSpecial Link:=False, DataType:=14, Placement:=0, _
DisplayAsIcon:=False
End Sub
The only issue is that the image is pasted as "In Line with Text" but I need it to be "Square with text wrapping". I can't get Word or Excel to record changing the image to "Square with text wrapping".
The PasteSpecial part only does wdFloatOverText or wdInLine for placement and neither of them solve this issue.
I am very new to VBA and have run out of ideas. I am still trying to find a way to format it, maybe using some kind of WITH statement. However I thought I would attempt to reach out for help while I continue google-foo and learning VBA from Youtube.
Using PasteAndFormat Type:=wdChartPicture links the chart to excel. So that didn't work.
Make sure you have a reference to the Word application in your VBE then immediately following a regular paste (wd.Selection.Paste), add these two lines of code:
wd.Selection.MoveStart word.WdUnits.wdCharacter, Count:=-1
wd.Selection.InlineShapes(1).ConvertToShape.WrapFormat.Type = wdWrapSquare
If you want to continue to use the PasteSpecial method you have in your code then replace the code line above "wd.Selection.MoveStart..." to this:
wd.Selection.MoveEnd word.WdUnits.wdCharacter, Count:=1
The reason is a regular paste leaves the active insertion point at the end of the inserted object. But if a PasteSpecial method is used the active insertion point is at the beginning of the object that was pasted. Why? I have no idea! Word VBA never ceases to amaze me. :-)