Somewhere on the internet I found this code to easily save a .docx file out of a .dotx file into the desired folder:
Sub SaveFileInTheCorrectDirectory()
ActiveDocument.SaveAs2 "[the correct directory, put in manually by me in the VBA code]" & InputBox("Type the desired file name", "Save As")
End Sub
However, this code automatically overwrites an already existing file with the same name (and in the same directory, of course). I've tried looking for code to fix this, and found a few suggestions:
Trying to save word file, from excel vba, without over-writing any existing files
https://answers.microsoft.com/en-us/msoffice/forum/all/vba-macro-saveas-overights-exsiting-file-without/e6fce3b1-ee72-498d-8fe5-fbc3e0cdbf23
http://computer-programming-forum.com/1-vba/2fb545278f4311ff.htm
https://groups.google.com/g/microsoft.public.word.vba.customization/c/Q4W2CK4gQOg?pli=1
But I can't figure out how to implement them...
Could someone be so kind to assist me?
Thanks!
PS Is there added value to use "SaveAs2" instead of "SaveAs" or the other way around?
That's as simple as:
Dim StrName as String
StrName = InputBox("Type the desired file name", "Save As")
If Trim(StrName) = "" then Exit Sub
If Dir(StrPath & StrName & ".docx") = "" Then ActiveDocument.SaveAs2 StrPath & StrName & ".docx"
where StrPath & StrName are the path & name, respectively.
Note: I haven't added any code for what to do if the file exists because you haven't said what you want to do in that case. Post a new question if you need help with that.
Related
I have an odd issue where I can connect and upload files to a sharepoint site using a vba script, however using practically the same vba script from another spreadsheet and uploading to the same sharepoint site I can't connect and upload files.
The weird thing with the vba script that doesn't work is that if I add the below code to it before the rest of the script, the rest of the script works.
xPath= "https://teamspace.healthcare.siemens.com/content/90002613/Documents/"
With ActiveWorkbook
Application.ActiveWorkbook.SaveAs Filename:=xPath & Name & ".xlsm"
Application.ActiveWorkbook.Close False
End With
No idea why but xPath is a valid file path when using the SaveAs command, but when I use the same path or variant of it with the "Dir" tag it doesn't work and either give me a error code "Runtime 52 Bad File name or number" or "Runtime 76 path not found". Please can someone help with this, I have been trying everything I can think of for about the last 2 days
Thanks
Edit :
this is the code that works in one of the spreadsheets
If Dir("//teamspace.healthcare.siemens.com/content/90002613/Documents/GB_Invivo_RSM/" & xWs.Name & "", vbDirectory) = "" Then
MkDir ("//teamspace.healthcare.siemens.com/content/90002613/Documents/GB_Invivo_RSM/" & xWs.Name & "")
Else
End If
With ActiveWorkbook
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\GB_RSM_P" & Format(LDate, "mm") & "FY" & Format(LDate, "yyyy") & " " & xWs.Name & ".xlsx"
End With
The code in the 2nd spreadsheet wont work unless I put another SaveAs() before all of this, and save a dummy spreadsheet, then have to delete it after, because obviously I don't want it there. I can't understand why the same code would work from one spreadsheet and not another, and also its almost like the saveAs() is creating a connection or something, but this wasn't needed in the 1st spreadsheet
If your URL is "https://teamspace.healthcare.siemens.com/content/90002613/Documents/" then you should be able to use Dir() as shown below:
Sub TestWebDAVDir()
Const MY_PATH As String = "\\teamspace.healthcare.siemens.com\content\90002613\Documents\"
Dim f
f = Dir(MY_PATH & "*")
Do While Len(f) > 0
Debug.Print f
f = Dir()
Loop
End Sub
Simple code to loop paste .emf files into word:
Sub LoopEMF()
Dim sPic As String
Dim sPath As String
sPath = "C:\Users\me\Desktop\Test2\"
sPic = Dir(sPath & "*.emf")
Do While sPic <> ""
Selection.TypeParagraph
Selection.InlineShapes.AddPicture _
FileName:=sPath & sPic, _
LinkToFile:=False, SaveWithDocument:=True
sPic = Dir
Selection.TypeParagraph
Loop
End Sub
Rather than a specified directory, I simply want to look in the active directory in which the word file (that is open) is located. Much searching has yielded no clue - which is surprising, embarrassing and probably means I'm not using the right key words.
Help?
When I open an Excel document D:\db\tmp\test1.xlsm:
CurDir() returns C:\Users\[username]\Documents
ActiveWorkbook.Path returns D:\db\tmp
So CurDir() has a system default and can be changed.
ActiveWorkbook.Path does not change for the same saved Workbook.
For example, CurDir() changes when you do "File/Save As" command, and select a random directory in the File/Directory selection dialog. Then click on Cancel to skip saving. But CurDir() has already changed to the last selected directory.
From:
How to get current working directory using vba?
Even more embarrassing - I had been using the correct code:
Sub NewLoopEMF()
Dim sPic As String
Dim sPath As String
sPath = ActiveDocument.path & "\"
sPic = Dir(sPath & "*.emf")
Do While sPic <> ""
Selection.TypeParagraph
Selection.InlineShapes.AddPicture _
FileName:=sPath & sPic, _
LinkToFile:=False, SaveWithDocument:=True
sPic = Dir
Selection.TypeParagraph
Loop
End Sub
Unfortunately, the active directory is in a synced SharePoint folder, so the returned name is in hypertext (http://all the rest/) and with this, all you know what breaks loose. I figured this out by using this code:
Sub GetActiveDocumentPath()
MsgBox ActiveDocument.path
End Sub
So it seems the simple solution is to not use a sharepoint folder to store the items. Anyone have a clever solution for those of us working in the SharePoint environment?
I want to open 4 different Excel files saved under same folder using VBA code, but the folder path is not fixed.
Let's say, I have 4 Excel files named A.xlsx, B.xlsx, C.xlsx & D.xlsx under folder named 22-Feb-15 (This folder name will change everyday, but the file names will remain same).
I want VBA code so that I can select the folder manually and once it is selected, all 4 files will open one by one (there are other files too, but I need to open only these 4 files).
Please see below:
Sub FolderSelect()
Dim intResult As Integer
Dim fldrPath As String
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
If intResult <> 0 Then
fldrPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Workbooks.Open Filename:=fldrPath & "\" & "A.xlsx"
Workbooks.Open Filename:=fldrPath & "\" & "B.xlsx"
Workbooks.Open Filename:=fldrPath & "\" & "C.xlsx"
Workbooks.Open Filename:=fldrPath & "\" & "D.xlsx"
End If
End Sub
You can change file names and/or add new files by following the same structure
I'm doing a check to make sure that my code is able to see my file before I move to the next step of my program. This is my code, but it always displays as the path not existing. Did I do something wrong?
Sub NewNameiLoop()
Dim i As Double
Dim NameStr As String
Dim NewNamePath As String
NameStr = Renamer.New_Name.Text
NewNamePath = Renamer.Path_Text.Text & "\" + NameStr & "-" & Right("00" & i, 3) & ".ipt"
Do While i < 99 'Counts with the file name up to -099
i = i + 1
If vbOK Then
MsgBox (Renamer.Path_Text.Text & "\" + NameStr & "-" & Right("00" & i, 3))
If Dir(NewNamePath) <> "" Then
MsgBox "Path Exists."
Else: MsgBox "Path does not exist."
End If
Else: Exit Sub
End If
Loop
End Sub
Other information:
This code is in the module NewNameLoop in the sub NewNameiLoop.
The form it goes to is called Renamer. The form calls NewNameiLoop when the user clicks "Apply" to rename some files. After they are renamed, they call this code to check for the file's existence.
The MsgBox displayed contains the full, correct path.
This is in Autodesk Inventor, not Excel! Thus far, the coding has been pretty much the same. No weird quirks or anything.
JPEGs of what is happening. As explained below, I AM able to access C:\ and things within C:. The first parts of my program make a whole new folder and copy a different folder's contents in to it. After that it goes to the original folder and renames all the files. So does that mean it is indeed a coding problem? No one seems to know.
The Dir will return nothing if:
1) The .ipt file does not exists or the file name is different from what you coded
2) No access to the folder
If you are not concern with the filename I suggest to leave the NewNamepath as Renamer.Path_Text.Text & "\" and do a file search in this path for the file you are looking for
Yes, apparently you can't do a 'Dir' on that folder. But you can use FileSystemObject.
Add a Project reference to "Microsoft Scripting Runtime"
Then adapt the following approach:
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
If oFSO.FileExists(NewNamePath) Then
Debug.Print "Found it"
Else
Debug.Print "Not Found"
End If
Set oFSO = Nothing
I have a Macro Enabled Template called TIP-PBI.xltm. When I create a document based on this template, Excel automatically names it TIP-PBI1. However, I want to give it a custom name.
I figured I could do that by modifying the .Title property of the Workbook. To that end, on startup the Workbook_Open event kicks off, and the following is executed:
Private Sub Workbook_Open()
Dim strPBI As String
strPBI = InputBox$("Enter PBI", "Enter PBI")
ThisWorkbook.Title = "TIP-PBI-" & strPBI
End Sub
However, this does nothing.
How can I change the Title of the document on startup?
the only way to change the workbook name is to save it (ref) so you could do something like
ThisWorkbook.SaveAs ThisWorkbook.Path & "" & FileName & ".xls"
if you only want to suggest a name then you could use GetSaveAsFilename or
Application.FileDialog(msoFileDialogSaveAs).InitialFileName = ThisWorkbook.Path & "" & FileName & ".xls"
If the new workbook is created from a template then it takes the template name. Hence in instances where I wish to set the name of the new work book I copy a dummy template to the required name and then open the new workbook based upon the renamed template.
strFile = "C:\Temp\" & strnewname & ".xltx "
FileCopy "C:\Temp\Dummy.xltx", strFile
'Open template to new workbook
Workbooks.Open Filename:=strFile
Kill strFile 'delete renamed template