I'm trying to write a Macro to batch process a bunch of Word docs. I need to set the page size to "Legal" for more than 200 files. The code I've written is pretty simple and seems like it should work, but I can't get the Documents.Open command to execute successfully. Every time I get this result:
Run-time error '5174': This file could not be found.
(et cetera) -- even when I hard-code the filename. The file definitely does exist. Here's what I've got so far:
Public Sub MassFormatLegal()
Dim vDirPath As String
Dim vFile As String
Dim vFileName As String
Dim oDoc As Document
vDirPath = "MacMiniHD:Users:atc:Documents:TEST:"
vFile = Dir(vDirPath)
Do While vFile <> ""
vFileName = vDirPath & vFile
'* display the filename to verify that it's correct
MsgBox "vFileName: " + vFileName
'* open file
Set oDoc = Documents.Open("MacMiniHD:Users:atc:Documents:TEST:AAFILE.doc")
'* I also tried the following, all resulting in the same error
'*Set oDoc = Documents.Open(vFileName)
'*Set oDoc = Documents.Open(fileName:=vFileName)
'*Set oDoc = Application.Documents.Open(fileName:=vDirPath & vFile)
'* change paper size
oDoc.PageSetup.PaperSize = wdPaperLegal
'* save and close the document
oDoc.Close wdSaveChanges
'* get next file
vFile = Dir
Loop
MsgBox "Finished"
End Sub
Any suggestions? I've tried a lot of different approaches and am realizing that there are serious limitations of VBScript for Mac, but surely this kind of basic file handling is possible?!?
Related
I have a word document that uses mail merge feature and gets its information from the access db. When I use this code it does not open the word document with the current information. It opens the word document with the last saved information.
If I open the word document on its own, from the task bar, it asks if I want to run the SQL and I click yes and everything operates normally. I want to click a button from within access to accomplish this same task to open the contract.
Here is the code I used:
Private Sub Command205_Click()
Dim LWordDoc As String
Dim oApp As Object
'Path to the word document
LWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"
If Dir(LWordDoc) = "" Then
MsgBox "Document not found."
Else
'Create an instance of MS Word
Set oApp = CreateObject(Class:="Word.Application")
oApp.Visible = True
'Open the Document
oApp.Documents.Open FileName:=LWordDoc
End If
End Sub
***I should add that I am not a coder and know nothing about VBA, I copied this from this website so any help you can offer would be greatly appreciated. If you can provide me with coding or enough guidance to get me on the way would be great. Thank you
This code will run in Access to open a Mail Merge document and update content and save.
Using the link I originally posted (http://www.minnesotaithub.com/2015/11/automatic-mail-merge-with-vba-and-access/), I made a couple of modifications and was able to get that code to work.
I needed to add: ReadOnly:=True, _ to prevent a sharing violation
and I changed the Table Name of the source data.
NOTE!! You will need to change sode marked with'###' as follows:
###-1 Change to specify the full path of your TEMPLATE!!!
###-2 Change the SQLSTATEMENT to specify your recordsource!!!
Paste this code into your form, make sure you have a Command Button Click Event that executes (Either rename 'Command205' in this code, or change your control name).
Option Compare Database
Option Explicit
Private Sub Command205_Click()
Dim strWordDoc As String
'Path to the word document of the Mail Merge
'###-1 CHANGE THE FOLLOWING LINE TO POINT TO YOUR DOCUMENT!!
strWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"
' Call the code to merge the latest info
startMerge strWordDoc
End Sub
'----------------------------------------------------
' Auto Mail Merge With VBA and Access (Early Binding)
'----------------------------------------------------
' NOTE: To use this code, you must reference
' The Microsoft Word 14.0 (or current version)
' Object Library by clicking menu Tools > References
' Check the box for:
' Microsoft Word 14.0 Object Library in Word 2010
' Microsoft Word 15.0 Object Library in Word 2013
' Click OK
'----------------------------------------------------
Function startMerge(strDocPath As String)
Dim oWord As Word.Application
Dim oWdoc As Word.Document
Dim wdInputName As String
Dim wdOutputName As String
Dim outFileName As String
' Set Template Path
wdInputName = strDocPath ' was CurrentProject.Path & "\mail_merge.docx"
' Create unique save filename with minutes and seconds to prevent overwrite
outFileName = "MailMergeFile_" & Format(Now(), "yyyymmddmms")
' Output File Path w/outFileName
wdOutputName = CurrentProject.Path & "\" & outFileName
Set oWord = New Word.Application
Set oWdoc = oWord.Documents.Open(wdInputName)
' Start mail merge
'###-2 CHANGE THE SQLSTATEMENT AS NEEDED
With oWdoc.MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource _
Name:=CurrentProject.FullName, _
ReadOnly:=True, _
AddToRecentFiles:=False, _
LinkToSource:=True, _
Connection:="QUERY mailmerge", _
SQLStatement:="SELECT * FROM [tblEmployee]" ' Change the table name or your query
.Destination = wdSendToNewDocument
.Execute Pause:=False
End With
' Hide Word During Merge
oWord.Visible = False
' Save file as PDF
' Uncomment the line below and comment out
' the line below "Save file as Word Document"
'------------------------------------------------
'oWord.ActiveDocument.SaveAs2 wdOutputName & ".pdf", 17
' Save file as Word Document
' ###-3 IF YOU DON'T WANT TO SAVE AS A NEW NAME, COMMENT OUT NEXT LINE
oWord.ActiveDocument.SaveAs2 wdOutputName & ".docx", 16
' SHOW THE DOCUMENT
oWord.Visible = True
' Close the template file
If oWord.Documents(1).FullName = strDocPath Then
oWord.Documents(1).Close savechanges:=False
ElseIf oWord.Documents(2).FullName = strDocPath Then
oWord.Documents(2).Close savechanges:=False
Else
MsgBox "Well, this should never happen! Only expected two documents to be open"
End If
' Quit Word to Save Memory
'oWord.Quit savechanges:=False
' Clean up memory
'------------------------------------------------
Set oWord = Nothing
Set oWdoc = Nothing
End Function
I've tried to use the below code which I found on this conversation How To Search And Replace Across Multiple Files In Word? supplied by Charles Kenyon. However, it doesn't seem to work for me. I've enabled macros on my word and added the below code as a new module in Macros. When I go to replace all, it'll replace the text as per normal, but after doing this, when I open up the other macros enabled word doc, I find that the same text is still in these docs, without being replaced. Am I doing something wrong? Namely, I also wish to add a wildcard entry into my replace all, will the below code work or can someone suggest a better alternative? I have tested the below code with and without wildcard entries to no avail. I've also tried the code on this page in my macros but it also didn't work How to find and replace a text in multiple Word documents using VBAThanks for any help!
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub
I want to convert all docx files in a folder to PDF.
To accomplish my goals I put all the files (only docx) in the same folder than the docm and run the macro. It worked, but now it doesn't, even with the same files doesn't work anymore. Sometimes works for the first file and stop working with the following alert:
"Runtime error '5174':
This file could not be found
(C:\Users...\Archive.docx)"
The problem is always on the Documents.Open
Tried "OpenAndRepair", "ReadOnly", Putting nothing, etc.
Sub Converter()
Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
'Store Information About Word File
myPath = ActiveDocument.FullName
FileName = Mid(myPath, InStrRev(myPath, "\") + 1)
Dim strCaminho As String
strCaminho = ActiveDocument.Path
Dim fso As Object 'Scripting.FileSystemObject
Dim fld As Object 'Scripting.Folder
Dim fl As Object 'Scripting.File
Dim atual As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strCaminho)
For Each fl In fld.Files
If fl.Name <> FileName Then 'doesn't try to open the file with macro
Documents.Open FileName:=fl.Name
Word_ExportPDF 'A function that works
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
Next fl
End Sub
My code is a Frankenstein from other macros, is there a better way to Automatize this conversion?
Implement what Comintern had proposed:
You don't need to parse out the FileName - Word.Document give you direct access to that with .Name. The first thing I would do is collect the names of the documents first, then export them. You're modifying the directory contents as you iterate over it. - Comintern
Then, the following can be added to the code to check for valid document extensions:
If fl.Name <> FileName Then 'doesn't try to open the file with macro
If LCase(fso.GetExtensionName(fl.Path)) = "docx" Then '<----This Line
Documents.Open FileName:=fl.Path '<--------------------This Line
Word_ExportPDF 'A function that works
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End if
End if
I have a console app that lists docx files in a folder and converts them into another file type (pdf for example).
Here's code:
Sub Main()
For Each arg As String In My.Application.CommandLineArgs
Select Case Trim(LCase(arg))
Case "/docx-pdf"
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim path As String
Console.WriteLine("Podaj scieżkę folderu:")
path = Console.ReadLine()
Dim files As String() = Directory.GetFiles(path + "/", "*.docx")
For Each file As String In files
oWord = CreateObject("word.application")
oWord.Visible = False
oDoc = oWord.Documents.Open(file, ReadOnly:=True)
oDoc.SaveAs(FileName:=file.Replace(".docx", ".pdf"), FileFormat:=Word.WdSaveFormat.wdFormatPDF)
oWord.Quit()
Next
End Select
Next
End Sub
My problem is that after converting every file in the folder, the application is trying to open another one that doesn't exist and I'm getting THIS error (at least it looks like that).
What did I forget about?
You are getting file opening error saying that "the file is probably damaged" most likely because your wildcard *.docx is also leading to inclusion of temporary files created by Word whenever DOCX files are open for editing (more specifically here: KB 211632 – see paragraph Owner File) which have file name beginning with tilde and dollar sign (~$), e.g. ~$nualReport.docx. These files contain no document content, but only logon name of person who opened corresponding DOCX file. You are attempting to open these owner files using Microsoft Word what indeed fails.
You have two options how to resolve this:
rely on fact that these owner files are actually hidden (that have h attrbute set) so get only list of non-hidden DOCX files
test each file name before processing and if it begins with ~$, just use Continue For to skip further processing of the file (I recommend this option)
'...
For Each file As String In files
If IO.Path.GetFileName(file).StartsWith("~$") Then Continue For 'inserted line
oWord = CreateObject("word.application")
'...
Okay, 2nd option doesn't work for me so i did it like this:
Sub Main()
For Each arg As String In My.Application.CommandLineArgs
Select Case Trim(LCase(arg))
Case "/docx-pdf"
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim path As String
Console.WriteLine("Podaj scieżkę folderu:")
path = Console.ReadLine()
Dim afiles As String() = Directory.GetFiles(path + "\", "*.docx")
Dim bfiles As String() = Directory.GetFiles(path + "\", "~$*")
Dim cfiles = afiles.Except(bfiles)
For Each file As String In cfiles
oWord = CreateObject("word.application")
oWord.Visible = False
oDoc = oWord.Documents.Open(file, ReadOnly:=True)
oDoc.SaveAs(FileName:=file.Replace(".docx", ".pdf"), FileFormat:=Word.WdSaveFormat.wdFormatPDF)
oWord.Quit()
Next
End Select
Next
End Sub
Any other way to write it a bit shorter and cleaner?
I need to add text string to all files on a folder, as a footer
For example, on the folder on the path and called C:\mobatchscripts\
I have a random number of txt files, with text.
I want to add a line for example "text" on each of the text files on the folder
I have little knowledge of vba programming, but for what I have read I can use append, but I need something that loop on the files on the folder, and modify them.
So far I tried this:
Sub footer()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
FolderPath = "C:\mobatchscripts\"
FileName = Dir(FolderPath)
Do While FileName <> ""
Open FileName For Append As #1
Print #1, "test"
Close #1
FileName = Dir
Loop
End Sub
But seems that its not looking into the files, or appending the text.
On the assumption that you're writing to text files (I see "batchscripts" in the path), you need a reference to the Microsoft Scripting Runtime (Within the VBE you'll find it in Tools, References)
Option Explicit
Public Sub AppendTextToFiles(strFolderPath As String, _
strAppendText As String, _
blnAddLine As Boolean)
Dim objFSO As FileSystemObject
Dim fldOutput As Folder
Dim filCurrent As File
Dim txsOutput As TextStream
Set objFSO = New FileSystemObject
If objFSO.FolderExists(strFolderPath) Then
Set fldOutput = objFSO.GetFolder(strFolderPath)
For Each filCurrent In fldOutput.Files
Set txsOutput = filCurrent.OpenAsTextStream(ForAppending)
If blnAddLine Then
txsOutput.WriteLine strAppendText
Else
txsOutput.Write strAppendText
End If
txsOutput.Close
Next
MsgBox "Wrote text to " & fldOutput.Files.Count & " files", vbInformation
Else
MsgBox "Path not found", vbExclamation, "Invalid path"
End If
End Sub
I'd recommend adding error handling as well and possibly a check for the file extension to ensure that you're writing only to those files that you want to.
To add a line it would be called like this:
AppendTextToFiles "C:\mobatchscripts", "Test", True
To just add text to the file - no new line:
AppendTextToFiles "C:\mobatchscripts", "Test", False
Alternatively, forget the params and convert them to constants at the beginning of the proc. Next time I'd recommend working on the wording of your question as it's not really very clear what you're trying to achieve.