I wrote the following procedure to save my file to a network path:
Sub Save_Book()
Dim savePATH As String
savePATH = "\\ftl-store\Departments\HR\HR Reports and Metrics\LOA Reports\BRT Reports"
Application.ScreenUpdating = True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=savePATH & sFile, FileFormat:=51
Application.DisplayAlerts = False
End Sub
However, my procedure is not working correctly. Its saving the file to the path, but the correct path. It saves the file to here: \\ftl-store\Departments\HR\HR Reports and Metrics\LOA Reports\BRT Reports" Thus missing the destination folder.
Instead of saving the file to the path it takes this part:
BRT Reports
and shows as part of my file name when it saves.
Any help will be appreciated.
You must add the trailing backslash:
Sub Save_Book()
Dim savePATH As String
savePATH = "\\ftl-store\Departments\HR\HR Reports and Metrics\LOA Reports\BRT Reports\"
Application.ScreenUpdating = True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=savePATH & sFile, FileFormat:=51
Application.DisplayAlerts = False
End Sub
Related
I'm attempting to put together some code in VBA where it will open a specific folder, let me choose the file then continue running my code.
Currently what I have (below) "works" in that it will open a folder but usually it starts from a generic location (Desktop) but will not go the the specific folder location to let me open the file I want.
Dim Filename as String
filename = Application.GetOpenFilename(FileFilter:="Excel Files, *.xl*;*.xm*")
If filename <> False Then
Workbooks.Open filename:=filename
End If
I've also tried something like this:
Dim Directory as String
Dim Filename as String
Directory = "\\page\data\NFInventory\groups\CID\Retail Setting\Lago Retail Uploads\" & strBrand & "\" & strSeason & "\" & strPrefix & "\"
Filename = Dir(Directory & "*.xl*;*.xm*")
Workbooks.Open Filename:=Directory
But it doesn't do anything and I think I have everything right. Any help or push in the right direction would be greatly appreciated.
-Deke
This will start an Open Dialog at the specified location:
Sub openBeckJFolder()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
.InitialFileName = "C:\Users\beckj\"
End With
End Sub
The Microsoft document page doesn't really get into it, but FileDialog has several features such as the InitialFileName that I used here.
_
UPDATE: To open the workbook
Code added that allows you to highlight the workbook & click Open, or double-click on the workbook to open it.
Sub openBeckJFolder()
Dim Filename As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "C:\Users\beckj\"
If .Show = True Then
Filename = .SelectedItems(1)
End If
End With
Workbooks.Open (Filename)
End Sub
I have many macros that have the following path definition:
"X:\Test\3rd Party\Other Files\"
But what I need to, which is what I did with the vbscripts, is make it like this:
"\\ServerName\Folder\Test\3rd Party\Other Files\"
This is because the files that have the macros in them are on the server and they need to be able to be executed by anyone who has access to the server - and since each person might map the drive with a different letter and/or have different levels of access, the first option wont work.
When I use this:
"\\ServerName\Folder\Test\3rd Party\Other Files\"
I get the error:
Sorry, we couldn't find \ServerName\Folder\Test\3rd Party\Other
Files. Is it possible it was moved, renamed or deleted?
When I use this:
"\\ServerName\Folder\Test\3rd Party\Other Files"
Note the backslash missing at the end of the string
I get the error:
Excel cannot access "Other Files". The document may be read-only or
encrypted.
Sub RenameOriginalFilesSheets()
Const TestMode = True
Dim WB As Workbook
Application.ScreenUpdating = False
rootpath = "\\ServerName\Folder\Test\Terminations\"
aFile = Dir(rootpath & "*.xlsx")
Do
Set WB = Application.Workbooks.Open(rootpath & aFile, False, AddToMRU:=False)
WB.Sheets(1).Name = Left$(WB.Name, InStrRev(WB.Name, ".") - 1)
WB.Close True
aFile = Dir()
DoEvents
Loop Until aFile = ""
Application.ScreenUpdating = True
End Sub
Try this, I test in VBA and it works.
Sub serverfolder()
Dim StrFile As String
StrFile = Dir("\\ServerIP\Folder\" & "*")
Do While StrFile <> ""
StrFile = Dir
Loop
End Sub
I am trying to figure out what suddenly changed in excel to make my code stop working specifically because of the asterisk wildcard. I had this code as a front end to combine data files (both .xls and .xlsx) into a blank file that contained the code shown below. This was working fine and used numerous times without a problem. The file itself and the code were done on Excel 2016 a few weeks ago.
Now when it runs, I am receiving "run time error 1004 application defined or object defined error" and I have no clue why. I tinkered with the text on every line and I am pretty sure it is ".xl" that is causing the error.
I replaced the ".xl" with an actual file name from a destination folder and it worked no problem. Why would using asterisk suddenly cause this error?
Has anyone ran accross this before ? I have searched high and low and could not find anyone reporting something exactly the same. Here is what I have been using, and again, it was working fine for a couple weeks now.
Sub MergeDataFiles()
Dim sPath As String
Dim MyFile As String
Dim wBk As Workbook
sPath = InputBox("Paste File Path Here")
MyFile = Dir(sPath & "\*.xl*")
Application.EnableEvents = False
Application.ScreenUpdating = False
Do While Len(MyFile) > 0
Set wBk = Workbooks.Open(sPath & MyFile)
wBk.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
wBk.Close True
MyFile = Dir()
Loop
ActiveWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I think the backslash ambiguity is causing the problem here.
I'd suggest removing it if it's there and then adding it in manually where the code requires it:
Sub MergeDataFiles()
Dim sPath As String
Dim MyFile As String
Dim wBk As Workbook
sPath = InputBox("Paste File Path Here")
If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1) ' strip away last backslash if present
MyFile = Dir(sPath & "\*.xl*")
Application.EnableEvents = False
Application.ScreenUpdating = False
Do While Len(MyFile) > 0
Set wBk = Workbooks.Open(sPath & "\" & MyFile) ' include backslash to keep full path correct
wBk.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
wBk.Close True
MyFile = Dir()
Loop
ActiveWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I have to do this whenever I save the excel file:
Save the file at one drive location (overwrite if same name file exists)
Go back to original location of the file and save it there as well (overwrite the file)
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim thisPath As String
Dim oneDrivePath As String
thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name
ActiveWorkbook.SaveAs _
Filename:=oneDrivePath
Do
Loop Until ThisWorkbook.Saved
ActiveWorkbook.SaveAs _
Filename:=thisPath
Do
Loop Until ThisWorkbook.Saved
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
But this doesn't works it's stucks in an infinte loop or Excel goes in Not Responding State. Anyidea how to achieve this task ?
The reason I can think of why it fails is maybe it's triggered everytime the file is saved but shouldn't Application.EnableEvents = False stop it from happening ? '
EDIT#1:
I tried stepping through the code it goes into Not Responding State after the Code gets though End Sub line
FileCopy may be useful here, since you don't care to overwrite the data, I think that would save you the loop for saved state (since Filesystem Object would take care of resolving the network delays ideally). I'd change the logic to:
1. Save this workbook
2. Overwrite my desired location
3. User is left in the original workbook since you are only saving a copy of this workbook.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileSystemLibrary As Variant: Set FileSystemLibrary = CreateObject("Scripting.FileSystemObject")
Dim thisPath As String: thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Dim oneDrivePath As String: oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ThisWorkbook.Save
FileSystemLibrary.CopyFile FileSystemLibrary.GetFile(thisPath), oneDrivePath
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
you don't need to loop if all your doing is saving. try the below
Sub save()
pathForFirstSave = "C:\folder1\"
pathForSecondSave = "C:\anotherFolder\"
ActiveWorkbook.SaveAs Filename:=pathForFirstSave & "asdf.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=pathForSecondSave & "asdf.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Here is a snippet of the last part of a data manipulation macro:
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
Dim fullfilenamelength As Integer, filenamelength As Integer
fullfilenamelength = Len(ThisWorkbook.FullName)
filenamelength = Len(udfWBFilename("ThisOne"))
Dim newFilePath As String, newFileFullName As String
newFilePath = Left(ThisWorkbook.FullName, fullfilenamelength - filenamelength)
newFileFullName = newFilePath & "Aspects List.xlsx"
ActiveWorkbook.SaveAs Filename:=newFileFullName, FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks.Open Filename:=newFileFullName
Windows("Aspects List.xlsx").Activate
Beep
Application.DisplayAlerts = True
Application.StatusBar = False
End Sub
Here at the end, it saves the file as a macro-free workbook, then opens the new file.
Why does it close the old file when doing so?
(in other words, macro execution is stopped after running the line Windows("Aspects List.xlsx").Activate - the subsequent lines are never executed.)
Just remove this line
Workbooks.Open Filename:=newFileFullName
After performing ActiveWorkbook.SaveAs, your active workbook already refers to Aspects List.xlsx:
Before SaveAs:
After SaveAs:
Btw, it seems to me that
newFilePath = Left(ThisWorkbook.FullName, fullfilenamelength - filenamelength)
could be simplified to
newFilePath = ThisWorkbook.Path & "\"
Also it may be interesting: How to avoid using Select/Active statements