I'm attempting to use this code found here:
https://answers.microsoft.com/en-us/msoffice/forum/all/can-i-save-as-multiple-documents-at-one-time/eae10efb-1984-4131-b072-a96d45020ba9
Sub SaveAllOpenDocsAsDocx()
For Each aDoc In Application.Documents
aDoc.SaveAs FileName:=aDoc.FullName & ".doc", FileFormat:=wdFormatDocument
aDoc.Close
Next aDoc
End Sub
I'd like to save any open word documents to a specific folder path, how would I go about changing
FileName:=aDoc.FullName
to a specific locations e.g. C:\Users\joe.blog\Desktop\Backup
Using FullName property includes the original path.
You need to pull out the Filename using the Name property and append that to your path
Something like this
Sub SaveAllOpenDocsAsDocx()
Const MY_LOCATION = "C:\Users\joe.blog\Desktop\Backup\"
Dim myFileLocation As String
For Each aDoc In Application.Documents
myFileLocation = MY_LOCATION & aDoc.Name & ".doc"
aDoc.SaveAs FileName:=myFileLocation, FileFormat:=wdFormatDocument
aDoc.Close
Next aDoc
End Sub
Related
I have a list of file names in a worksheet. I want to read a name, find the actual file, rename it and move on to the next name.
The 1st part, retrieving the name from the worksheet and modifying it to the new name is not a problem. The problem is assigning the new name to the file.
The Name function does not work because the files are on a different drive. I also tried Scripting.FileSystemObject.
The code runs but no change is made.
Here is the code I used...
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.GetFile(fOldName)
If Not Err = 53 Then 'File not found
'Rename file
f.Name = fNewName
End If
Did I make a code mistake I'm not seeing? Should I be using/doing something else?
Finding info on VBA and/or VB6 is getting pretty rare these days.
BTW. This is for Excel 2016.
Tks
If there was no misunderstanding...
FSO... it's bad in any case. It's just a bugsful API wrapper, written with a left chicken paw.
There are pure VB & API for more sophisticated cases.
No external libs & objects:
Public Sub sp_PrjFilMov()
Dim i As Byte
Dim sNam$, sExt$, sPthSrc$, sPthTgt$, sDir$
sPthSrc = "V:\"
sPthTgt = "R:\"
sNam = "Empty_"
sExt = ".dmy" ' dummy
For i = 1 To 5 ' create set of files for test
Call sx_CrtFil(i, sPthSrc, sNam, sExt)
Next
sDir = Dir(sPthSrc & "*" & sExt, vbNormal) ' lookup for our files ..
Do
'Debug.Print sDir
Select Case LenB(sDir)
Case 0
Exit Do ' *** EXIT DO
Case Else
Call sx_MovFil(sPthSrc, sDir, sPthTgt) ' .. & move them to another disk
sDir = Dir
End Select
Loop
Stop
End Sub
Private Sub sx_CrtFil(pNmb As Byte, pPth$, pNam$, pExt$)
Dim iFilNmb%
Dim sFilNam$
sFilNam = pPth & pNam & CStr(pNmb) & pExt
iFilNmb = FreeFile
Open sFilNam For Output As #iFilNmb
Close #iFilNmb
End Sub
Private Sub sx_MovFil(pPnmSrc$, pFnm$, pPthTgt$)
Dim sSrcPne$
sSrcPne = pPnmSrc & pFnm
'Debug.Print "Move " & sSrcPne & " --> " & pPthTgt
Call FileCopy(sSrcPne, pPthTgt & pFnm)
Call Kill(sSrcPne)
End Sub
'
I'm using these two functions to create project folders on startup. In the beginning I'm creating only one folder named ProjectName but now there's other folders on the same level with ProjectName named ProjectName_Inputs, ProjectName_Files, ProjectName_Outputs. I want to create them with my below code.
I wonder how can I adapt this to my code. I mean, is it possible to use an array or for loop etc.? path = [/ProjectName, ProjectName_Inputs, ProjectName_Files, ProjectName_Outputs] I don't know if it's possible?
Or can you suggest a more logical way to create them?
Sub CreateFolders()
Dim fso As New FileSystemObject
If Functions.FolderExists(path) Then
Exit Sub
Else
On Error GoTo FolderNotBuilt
fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
Exit Sub
End If
FolderNotBuilt:
MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
FolderCreate = False
Exit Sub
End Sub
This is the function that controls whether or not the directory created before
Function FolderExists(ByVal path As String) As Boolean
FolderExists = False
Dim fso As New FileSystemObject
If fso.FolderExists(path) Then FolderExists = True
End Function
Edited to amend a typo (End With missing) and change Resume to Resume Nextand skip the possibly screwed up path
I’d go like follows
Sub CreateFolders()
Dim path As Variant
With CreateObject("Scripting.FileSystemObject") 'create and reference a FileSystemObject object
For Each path In Array("path1*\", "path2", "path3")
If Not .FolderExists(path) Then 'loop through paths in array
On Error GoTo FolderNotBuilt
.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
End If
Next
End With
Exit Sub
FolderNotBuilt:
MsgBox "A folder could not be created for the following path: " & vbCrLf & vbCrLf & path & vbCrLf & "Check the path name and try again."
Resume Next
End Sub
I have a macro that executes and creates a PDF file. Each time the macro is run, a PDF is generated. I would like to move the last version of the report (run three times per day) to a folder titles 'Past Reports'. I have been playing around with the script below but it does not work for me. The Active Report folder only contains the most recent PDF created.
Can anyone offer help? Happy to add more info if needed.
Public Sub transferFile()
On Error GoTo nextIt
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
PDFPath = "D:\####\Pinging Program\Active Report\"
pastPDFPath = "D:\####\Pinging Program\Past Reports"
sSourceFile = PDFPath & Dir(PDFPath & "*.pdf")
sDestinationFile = "D:\####\Pinging Program\Past Reports"
'move file
If Dir(sSourceFile) <> "" Then
fileSystemObject.moveFile sSourceFile, sDestinationFile
End If
nextIt:
End Sub
Your destination folder is missing the final slash. Also as a suggestion for the future the error would have been a lot easier to understand if you weren't bypassing error handling as Victor had suggested. Your code would look like:
Public Sub transferFile()
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
PDFPath = "C:\test\Active Report\"
pastPDFPath = "C:\test\Past Reports"
sSourceFile = PDFPath & Dir(PDFPath & "*.pdf")
sDestinationFile = "C:\test\Past Reports\"
'move file
If Dir(sSourceFile) <> "" Then
fileSystemObject.moveFile sSourceFile, sDestinationFile
End If
End Sub
I have tested it and it worked as expected. Regards,
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.
I try to open, change and save a presentation, but it always gets opened as Read-Only:
If measTypesDict.Exists(MeasType) = False Then
Dim targetPath As String
Dim newPres As PowerPoint.presentation
measTypesDict.Add MeasType, New Dictionary
Set newPres = PowerPoint.Application.Presentations.Add(msoFalse)
targetPath = rootDir & "\final\" & MeasType & ".ppt"
newPres.SaveAs targetPath
' newPres.Close that is what's been missing
targetPresentationsDict.Add MeasType, Presentations.Open(targetPath, ReadOnly:=msoFalse, WithWindow:=msoFalse)
End If
From the Microsoft Documentation:
The ReadOnly parameter is used to open a presentation as Read-Only.
The following example opens a file named test.ppt as Read-Only.
Sub OpenPresentationReadOnly()
Presentations.Open "c:\test.ppt", msoTrue
End Sub
Can anyone give me a hint why this is the case? I am the owner of the target folder and I have full control according to the folder settings.
Can you try this:
Sub OpenPresentation()
Presentations.Open "c:\test.ppt"
End Sub
Hope it helps.