How to run macro in word without opening it.
I went through same question asked before.
Solution is:
Dim Word
Dim WordDoc
Set Word = CreateObject("Word.Application")
Word.Visible = False
Set WordDoc = Word.Documents.open("D:\working_folder\abc.doc")
Word.Run "<macroname>"
WordDoc.Save
Word.Quit
Set WordDoc = Nothing
Set Word = Nothing
This is working well for me too but in this case file name is specific ("abc.doc").
What if I want to run macro for all word files which are in the same folder?
The Macro is defined in all those files, I just want to know how to get all filenames in a folder.
Untested, but something like this:
Dim Word, fldr, f
Dim WordDoc
Set Word = CreateObject("Word.Application")
Word.Visible = False
fldr = "D:\working_folder\"
f = Dir(fldr & "*.doc*")
Do while f<>""
Set WordDoc = Word.Documents.open(fldr & f)
Word.Run "<macroname>"
WordDoc.Save
WordDoc.Close
f = Dir()
Loop
Word.Quit
Set WordDoc = Nothing
Set Word = Nothing
You can't run a macro without opening the file which contains it though.
Related
I want to copy a certain section (e.g. subject of the document then main body) to another Word document. The documents have different formatting so I need to copy to a predetermined location in the document.
The code below copies the whole of the source document to the target document.
Sub CopyPaste()
Dim Word As New Word.Application
Dim WordDoc As New Word.Document 'active document
Dim WordDoc1 As New Word.Document 'document to extract from
Dim dialogBox As FileDialog
Set dialogBox = Application.FileDialog(msoFileDialogOpen)
Dim Dest_path As String
dialogBox.AllowMultiSelect = False
dialogBox.Title = "Select a file to copy from"
'Show the file path and file name
If dialogBox.Show = -1 Then
MsgBox "You have selected: " & dialogBox.SelectedItems(1)
End If
' Starts extracting from source document
Set WordDoc1 = Word.Documents.Open(dialogBox.SelectedItems(1), ReadOnly:=True)
Application.Browser.Target = wdBrowseSection
For i = 1 To ((WordDoc1.Sections.Count) - 1)
WordDoc1.Bookmarks("\Section").Range.Copy
'Paste into an active document
ActiveDocument.Bookmarks("\Section").Range.PasteAndFormat wdFormatOriginalFormatting
WordDoc.ActiveWindow.Visible = True
WordDoc1.Close
Next i
End Sub
Since you're apparently running this from Word with an activedocument, you really don't want any of:
Dim Word As New Word.Application
Dim WordDoc As New Word.Document 'active document
Dim WordDoc1 As New Word.Document 'document to extract from
since that starts a new Word session and two new empty Word documents before you even get to the dialog.
As for:
.Bookmarks("\Section")
that only works in code like:
Set Rng = ActiveDocument.GoTo(What:=wdGoToSection, Name:=i)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\section")
Try something along the lines of:
Sub Replicate()
Dim DocSrc As Document, RngSrc As Range
Dim DocTgt As Document, RngTgt As Range
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Select a file for content replication"
'Show the file path and file name
If .Show = -1 Then
MsgBox "You have selected: " & .SelectedItems(1)
Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, Visible:=False)
Else: Exit Sub
End If
End With
Set DocTgt = ActiveDocument
' Starts extracting from source document
For i = 1 To ((DocSrc.Count) - 1)
Set RngTgt = DocTgt.Sections(i).Range
RngTgt.End = RngTgt.End - 1
Set RngSrc = DocSrc.Sections(i).Range
RngSrc.End = RngSrc.End - 1
RngTgt.FormattedText = RngSrc.FormattedText
Next i
DocSrc.Close False
End Sub
I wish I could just copy straight from excel but the program that I am copying into doesn't allow that.
This is what I have so far.
Sub exceltoword()
Dim RangeToCopy As Range
Set RangeToCopy = Range("A2")
Dim WordApp As Word.Application
Set WordApp = New Word.Application
WordApp.Visible = True
Dim WordDoc As Word.Document
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
WordDoc.Close
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Application.Wait (Now + TimeValue("0:00:005"))
Set RangeToCopy = Range("B2")
Set WordApp = New Word.Application
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
With a simple google search of how to copy from excel to word is where I found the below, I added comments that tell you where to change variables, you can add multiple tables pasted to any bookmarks you set in word, make sure you set your references.
your code will look something like this after you declare you word application
Option Base 1 'Force arrays to start at 1 instead of 0
Sub ExcelTablesToWord()
'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
(VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com
Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim TableArray As Variant
Dim BookmarkArray As Variant
'List of Table Names (To Copy)
TableArray = Array("MAKE YOUR TABLE ARRAY IN EXCEL AND PUT THE NAME HERE",)
'List of Word Document Bookmarks (To Paste To - in word goto Insert->Bookmark)
BookmarkArray = Array("BOOKMARK NAME FROM MICROSOFT WORD DOC HERE")
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set Variable Equal To Destination Word Document
On Error GoTo WordDocNotFound
Set WordApp = GetObject(class:="Word.Application")
WordApp.Visible = True
Set myDoc = WordApp.Documents("FULL FILE PATH TO YOUR WORD DOCUMENT")
On Error GoTo 0
'Loop Through and Copy/Paste Multiple Excel Tables
For x = LBound(TableArray) To UBound(TableArray)
'Copy Table Range from Excel
Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
tbl.Copy
'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(x)
WordTable.AutoFitBehavior (wdAutoFitWindow)
Next x
'Completion Message
MsgBox "Copy/Pasting Complete!", vbInformation
GoTo EndRoutine
'ERROR HANDLER
WordDocNotFound:
MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently open, aborting.", 16
'Put Stuff Back The Way It Was Found
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Basically you set your variables to the word application, define the arrays you want to paste in your excel sheet (in your instance B5?) then it will loop through and paste your arrays to the Bookmarks you set in your word document, which you can set to any location in your word document.
I am working on a macro to open a file(might already be open) and save with new name and then open the new file from vba in excel.
This file can Powerpoint,mathcad,visio, word etc..(can also be template files such as dotx etc..)
So my idea is that:
I first need to figure out if the application is open or not,
then I somehow need to figure if the file is open or not,
then save it with the new filename.
Open the new document
Go through the document and dumps custom variables into the database, populate custom variables from database(Not shown in code below, seperate module)
Activate the new document so that the user can edit it.
Public Sub saveAsVBADocument(filenameNew As String, fileNameOld As String, applicationType As String)
Dim objectApplication As Object
Dim documentApplication As Object
On Error Resume Next
Set objectApplication = GetObject(, applicationType)
On Error GoTo 0
If objectApplication Is Nothing Then
Set objectApplication = CreateObject(applicationType)
End If
objectApplication.Visible = True
On Error Resume Next
Set documentApplication = objectApplication.Workbooks(FileHandling.GetFilenameFromPath(fileNameOld)) 'Excel
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'Word
Set documentApplication = objectApplication.WorkSheets(FileHandling.GetFilenameFromPath(fileNameOld)) 'Mathcad
Set documentApplication = objectApplication.Presentations(FileHandling.GetFilenameFromPath(fileNameOld)) 'PowerPoint
Set documentApplication = objectApplication.Projects(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Project "Msproject.Application"
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Visio "Visio.Application"
If documentApplication Is Nothing Then
Set documentApplication = objectApplication.FileOpen(fileNameOld) ' add read only
End If
documentApplication.SaveAs filename:=filenameNew
Set objectApplication = Nothing
Set documentApplication = Nothing
End Sub
What is a possible solution to handle all vba acceptable document types?
You can use GetObject("Filename") to open a file directly in its application. So something like this can open any file that has its extension in the Windows Registry. That will be most file types; certainly the Office applications. Whether you'll be able to use SaveAs will depend on whether those applications support OLE Server (meaning they have a coding interface exposed). Again, all the Office applications do support this.
You'll probably want to put in some error-handling for the case the application for the file extension can't be found in the Registry. And of course in case the file name doesn't exist.
My example is for Excel and Word, only - you should be able to fill in others. My code makes sure the file is visible and available to the user as that makes it easier to trouble-shoot. You can, of course, change that once you have everything working satisfactorily.
Sub OpenFileInUnknownApp()
Dim objFile As Object
Dim objApp As Object
Dim sPath As String, sExt As String
Dim sFileName As String
Dim sAppName As String
Dim snewfilename As String
sPath = "C:\Test\"
sFileName = sPath & "Quote.docx" 'RngNames.xlsx"
snewfilename = sPath & "NewName"
'''Open the file in its application
Set objFile = GetObject(sFileName)
Set objApp = objFile.Application
sAppName = objApp.Name
Select Case sAppName
Case Is = "Microsoft Excel"
Dim wb As Excel.Workbook
sExt = "xlsx"
objApp.Visible = True
Set wb = objFile
wb.Activate
wb.Windows(1).Visible = True
objApp.UserControl = True 'so that it "lives" after the code ends
objApp.Activate
wb.SaveAs "sNewFileName" & sExt
Case Is = "Microsoft Word"
Dim doc As word.Document
sExt = "docx"
objApp.Visible = True
Set doc = objFile
objApp.Activate
doc.SaveAs2 "sNewFileName" & sExt
Case Else
End Select
Set objFile = Nothing
Set objApp = Nothing
End Sub
When I copy a chart from Excel ('Report' sheet) to a WORD file ('Report template.docx'), why does VBA wipe out the previous content of the WORD file? I suspect the problem is in line 'wddoc.Range.Paste' but I don't know how to change it to avoid the problem.
Sub ActivateWordTransferData()
Dim wdapp As Object, wddoc As Object
Dim strdocname As String
Set wdapp = GetObject(, "Word.Application")
wdapp.Visible = True
strdocname = "C:\users\ian\Documents\Dropbox\Report template.docx"
Set wddoc = wdapp.documents(strdocname)
Worksheets("Report").Shapes("Chart 2").Copy
wdapp.Activate
wddoc.bookmarks("bkmark4").Select
wddoc.Range.Paste
wddoc.Save
Set wddoc = Nothing
Set wdapp = Nothing
Application.CutCopyMode = False
End Sub
I'm not sure why the contents of the Word document are being overwritten.
However, removing the .Select operation and just pasting into the bookmark's range seems to work.
Remove these lines:
wddoc.bookmarks("bkmark4").Select
wddoc.Range.Paste
and replace with this line:
wddoc.bookmarks("bkmark4").Range.Paste
I've been working in exporting a rtf (rich text) form a memo field in access 2010 to a word file with a bookmark. The problem is that It is necessary two clicks to open the word document, and then, the text is inserted twice. I'm still not able to find the problem.
Here is the code:
Option Compare Database
Private Sub Comando72_Click()
'Saves the current record -->
Me.Dirty = False
Dim appWord As Word.Application
Dim doc As Word.Document
Dim objWord As Object '' Word.Application
Dim fso As Object '' FileSystemObject
Dim f As Object '' TextStream
Dim myHtml As String
Dim tempFileSpec As String
' grab some formatted text from a Memo field
myHtml = DLookup("DescripActivAEjecutarse", "PlanificacionServiciosInstitucionales", "IdPSI = Form!IdPSI")
Set fso = CreateObject("Scripting.FileSystemObject") '' New FileSystemObject
tempFileSpec = fso.GetSpecialFolder(2) & "\" & fso.GetTempName & ".htm"
'' write to temporary .htm file
Set f = fso.CreateTextFile(tempFileSpec, True)
f.Write "<html>" & myHtml & "</html>"
f.Close
Set f = Nothing
Set fso = Nothing
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If
'set the doc for future use.
Set doc = appWord.Documents.Open("C:\Users\earias\Documents\SOLICITUD-Yachay-automatica2.docx", , True) 'True default (just reading).
'locates bookmark and inserts file
appWord.Selection.GoTo what:=wdGoToBookmark, Name:="bookmark_1"
appWord.Selection.InsertFile tempFileSpec
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
If you are pressing the button twice it will run the procedure twice?
In terms of your current code,
after this line Set doc = appWord.Documents.Open add the following;
doc.visible = true
This should enable you to view the document that's open when you press the button once. To prevent the window from popping up you could also instead of setting it to visible do;
doc.saveas "path here"
then set all to nothing and close off as you would and the file will be saved where you want it saved without needing to manually save as each time.
You could look at setting up a simple mail merge with a template and then saving-as the template to whichever format you choose and break the mailmerge link (my preferred method).
Let me know how you get on!