I am a professor in an English department, and my composition students often write multiple drafts of their essays. I use Word 2010 to track their changes.
I discovered VBA code on another site (located here). I created a new macro. It prompts me correctly for the base, new, and comparison folders, but the output is null.
I have the files in both the base and new folders named identically and saved in .doc format. I also set the trust center options in Word to 1) enable all macros and 2) trust access to the VBA project object model.
Sub CompareAllFiles()
Dim strFolderA As String
Dim strFolderB As String
Dim strFolderC As String
Dim strFileSpec As String
Dim strFileName As String
Dim objDocA As Word.Document
Dim objDocB As Word.Document
Dim objDocC As Word.Document
strFolderA = InputBox("Enter path to base documents:")
strFolderB = InputBox("Enter path to new documents:")
strFolderC = InputBox("Enter path for document comparisons to be saved:")
strFileSpec = "*.doc"
strFileName = Dir(strFolderA & strFileSpec)
Do While strFileName <> vbNullString
Set objDocA = Documents.Open(strFolderA & strFileName)
Set objDocB = Documents.Open(strFolderB & strFileName)
Application.CompareDocuments _
OriginalDocument:=objDocA, _
RevisedDocument:=objDocB, _
Destination:=wdCompareDestinationNew
objDocA.Close
objDocB.Close
Set objDocC = ActiveDocument
objDocC.SaveAs FileName:=strFolderC & strFileName
objDocC.Close SaveChanges:=False
strFileName = Dir
Loop
Set objDocA = Nothing
Set objDocB = Nothing
End Sub
If you and your students are using Word 2010 then the extension would most likely be .docx:
strFileSpec = "*.docx"
Have you tried running the code step-by-step with the VBA debugger, to see what is the exact point of failure? See here (under the section entitled Stepping Through Code) for a simple introduction.
Some kind VBA guru figured it out for me: I need to enter a \ at the end of the folder paths. Without the final backslash, the script was not able to locate the folders, and thus it wasn't processing any files. After adding the final \ to all three folder paths, the code ran perfectly.
As a bonus, the code processes both .doc and .docx files. I thought I was going to have to convert all my .docx files to .doc before processing, but the code is smarter than that.
Eureka!
Related
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'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?!?
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.
This seems so simple and I've had it working multiple times, but something keeps breaking between my Dir call (to iterate through a directory) and opening the current file. Here's the pertinent code:
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceCurrentFile)
What I get with this is a file access error as the Application.Workbooks.Open is trying to open "C:\ExcelWIP\TestSource\\FILENAME" (note extra slash)
However when I take the final slash out of SourceLoc, the results of Dir(SourceLoc) are "" (it doesn't search the directory).
The frustrating thing is that as I've edited the sub in other ways, the functionality of this code has come and gone. I've had it work as-is, and I've had taking the '/' out of the directory path make it work, and at the moment, I just can't get these to work right together.
I've scoured online help and ms articles but nothing seems to point to a reason why this would keep going up and down (without being edited except for when it stops working) and why the format of the directory path will sometimes work with the final '/' and sometimes without.
any ideas?
This would open all .xlxs files in that directory son.
Sub OpenFiles()
Dim SourceCurrentFile As String
Dim FileExtension as String: FileExtension = "*.xlxs"
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
SourceCurrentFile = Dir()
'Start looping through directory
Do While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc &"\"& SourceCurrentFile)
SourceCurrentFile = Dir(FileExtension)
Loop
End Sub
JLILI Aman hit on the answer which was to take the results of Dir() as a string. Using that combined with the path on Application.Open allows for stable behaviors from the code.
New Code:
Dim SourceLoc as String
Dim SourceCurrentFile as String
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc & "/" & SourceCurrentFile)
I didn't include the recommended file extension because I'm dealing with xls, xlsx, and xlsm files all in one directory. This code opens all of them.
Warning - this code will set current file to each file in the directory including non-excel files. In my case, I'm only dealing with excel files so that's not a problem.
As to why this happens, it does not appear that Application.Open will accept the full object results of Dir(), so the return of Dir() needs to be a String. I didn't dig deeper into the why of it beyond that.
Consider using VBA's FileSystemObject which includes the folder and file property:
Sub xlFilesOpen()
Dim strPath As String
Dim objFSO As Object, objFolder As Object, xlFile As Object
strPath = "C:\ExcelWIP\TestSource"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
For Each xlFile In objFolder.Files
If Right(xlFile, 4) = "xlsx" Or Right(xlFile, 3) = "xls" Then
Application.Workbooks.Open (xlFile)
End If
Next xlFile
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
I need to read all the item titles for all the documents in a SharePoint document library directly into an Array using Excel VBA. I can't seem to successfully use FileSystemObject and I do not want to map the document library to a drive letter as the macro will be distributed and widely used.
The SharePoint site has an https address
I have looked at this thread about referencing scrrun.dll but it does not work because I cannot change the trust settings on my local domain
This thread looked promising, but again it seems to use FileSystemObject which might be my hang up.
This thread on the SharePoint stackexchange site works well for reading in a list of files as a worksheet object, but I don't know how it could be adapted to be pushed directly into an array.
I tend to receive Error 76 "Bad Path", but I am easily able to execute on local (C:) files.
I have tried using a WebDAV address - like the answer I gave to this thread - but it too encounters a "Bad Path" error.
There must be a way to read in the contents of a SharePoint document library directly into an array that does not violate my local security policies and doesn't depend upon an excel worksheet.
Ok I am going to self answer. I'm not 100% thrilled with my solution, but it does suffice within my constraints. Here are the high level points:
Use VBA to create BAT files that have the "Net Use" command within them.
Reference the WebDAV address of the document library and find an available drive letter
I doubt that any of my users already have 26 mapped drives...).
Once the document library is mapped it can be iterated through using FileSystemObject commands and the item titles can be loaded into a two dimensional array.
The code will have to be modified to allow for 3 the listing of subfolders
The location of the file count in the ListMyFiles sub would have to be changed or another dimension would have to be added to the array.
Here is the code - I will try to credit all Stack solutions that were integrated into this answer:
Private Sub List_Files()
Const MY_FILENAME = "C:\BAT.BAT"
Const MY_FILENAME2 = "C:\DELETE.BAT"
Dim i As Integer
Dim FileNumber As Integer
Dim FileNumber2 As Integer
Dim retVal As Variant
Dim DriveLetter As String
Dim TitleArray()
FileNumber = FreeFile
'create batch file
For i = Asc("Z") To Asc("A") Step -1
DriveLetter = Chr(i)
If Not oFSO.DriveExists(DriveLetter) Then
Open MY_FILENAME For Output As #FileNumber
'Use CHR(34) to add escape quotes to the command prompt line
Print #FileNumber, "net use " & DriveLetter & ": " & Chr(34) & "\\sharepoint.site.com#SSL\DavWWWRoot\cybertron\HR\test\the_lab\Shared Documents" & Chr(34) & " > H:\Log.txt"
Close #FileNumber
Exit For
End If
Next i
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
'This area can be used to evaluate return values from the bat file
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'This calls a function that will return the array of item titles and other metadata
ListMyFiles DriveLetter & ":\", False, TitleArray()
'Create code here to work with the data contained in TitleArray()
'Now remove the network drive and delete the bat files
FileNumber2 = FreeFile
Open MY_FILENAME2 For Output As #FileNumber2
Print #FileNumber2, "net use " & DriveLetter & ": /delete > H:\Log2.txt"
Close #FileNumber2
retVal = Shell(MY_FILENAME2, vbNormalFocus)
'Delete batch file
Kill MY_FILENAME
Kill MY_FILENAME2
End Sub
Here is the function that will read through the directory and return the array of file information:
Sub ListMyFiles(mySourcePath As String, IncludeSubFolders As Boolean, TitleArray())
Dim MyObject As Object
Dim mySource As Object
Dim myFile As File
Dim mySubFolder As folder
Dim FileCount As Integer
Dim CurrentFile As Integer
'Dim TitleArray()
Dim PropertyCount As Integer
CurrentFile = 0
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
FileCount = mySource.Files.Count
ReDim TitleArray(0 To FileCount - 1, 4)
'On Error Resume Next
For Each myFile In mySource.Files
PropertyCount = 1
TitleArray(CurrentFile, PropertyCount) = myFile.Path
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.Name
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.Size
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.DateLastModified
CurrentFile = CurrentFile + 1
Next
'The current status of this code does not support subfolders.
'An additional dimension or a different counting method would have to be used
If IncludeSubFolders = True Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True, TitleArray())
Next
End If
End Sub
Thank you to Chris Hayes for his answer to find empty network drives; thank you to Kenneth Hobson on ozgrid for his expanded answer on listing files in a directory. The rest of the code is ancient and I dredged it out of a folder I last touched in 2010.