VBA - Write to a mapped network drive - excel

Hello to the VBA Developers
I'd like to write to a mapped network drive ( P:\)
The following code doesn't seem to function and generates the error executing 76. Could you explain to me the reason for this error and how to resolve it?
Thank you very much for your advice in advance.
Sub Enregistre_Fichier_bon_nom_bon_endroit()
ChDrive "P"
ChDir "P:\SG\INFOR\"
Repertoire = Sheets("MAJ").Range("B1").Value & "\" & Sheets("FICHE_DEMANDE").Range("AH2").Value & "\"
ChDir Repertoire
SaveFileName = CurDir & "\" & Sheets("FICHE_DEMANDE").Range("B14").Value & "_" & Sheets("FICHE_DEMANDE").Range("a4").Value & "_ Suivi_FIR_directions_metier_2015_"
MsgBox (SaveFileName)
Set REP = Application.FileDialog(msoFileDialogSaveAs)
With REP
.AllowMultiSelect = False
.InitialFileName = SaveFileName
.FilterIndex = 2
If .Show = -1 Then
ActiveWorkbook.SaveAs Filename:=SaveFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
End With
End Sub

instead os using changedir i suggest to use full filename
like
Repertoire = Sheets("MAJ").Range("B1").Value & "\" & Sheets("FICHE_DEMANDE").Range("AH2").Value & "\"
SaveFileName = "P:\" & Repertoire & "\" & Sheets("FICHE_DEMANDE").Range("B14").Value & "_" & Sheets("FICHE_DEMANDE").Range("a4").Value & "_ Suivi_FIR_directions_metier_2015_"

Related

Using the Current Month in a Folder Path in VBA Code

When I run this code I get an error message
"compile error: named argument not found".
Sub SavetoCurrentMonth()
Application.DisplayAlerts = False
' Check for month folder and create if needed
If Len(Dir("C:\Users\OsmonBek\Documents\macros test\" & Format(Month(Date), "P00-") & Format(Date, "mmmm"), vbDirectory)) = 0 Then
MkDir "C:\Users\OsmonBek\Documents\macros test\" & Format(Month(Date), "P00-") & Format(Date, "mmmm")
End If
' Save File
ActiveWorkbook.ExportAsFixedFormat Filename:= _
"C:\Users\OsmonBek\Documents\macros test\" & MonthName(Month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As:" & vbNewLine & "C:\Users\OsmonBek\Documents\macros test\" & MonthName(Month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".xlsx"
End Sub
The error was telling you that ExportAsFixedFormat doesn't have a parameter called FileFormat.
I'd use something like this function to return the name of the folder for the current month (creating the folder if it doesn't already exist) like c:\P2022_04\.
Function getMonthFolderPath() As String
'creates/returns folder name for current month, like: c:\P2022_04\
Const basePath = "c:\", prefix = "P"
Dim path As String
path = basePath & prefix & Format(Date, "yyyy_mm")
If Dir(path, vbDirectory) = "" Then MkDir path
getMonthFolderPath = path & "\"
End Function
I added the year since (I assume) you don't all April's in the same folder.
Here's a variation that will (if needed) create a year folder with a month subfolder, and return that path:
Function getMonthFolderPath() As String
Dim path As String
path = "c:\"
path = path & Year(Date)
If Dir(path, vbDirectory) = "" Then MkDir path
path = path & "\" & Format(Date, "mm")
If Dir(path, vbDirectory) = "" Then MkDir path
getMonthFolderPath = path & "\"
End Function
Either variation could be used to save the current file, like this:
Sub saveDemo()
'save this workbook like: C:\2022\04\2022-04-08.xlsm
Dim fName As String
fName = getMonthFolderPath & Format(Date, "yyyy-mm-dd") & ".xlsm"
Application.DisplayAlerts = False 'ignore overwrite warning
ThisWorkbook.SaveAs fName, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
End Sub

Variable not being consistant in excel vba macro

I have a macro in excel that if a drive exists the macro saves the file to my harddrive and thumbdrive. If it doesn't exist, it saves to the harddrive. When the macro runs I am getting an error. Here is the macro:
Sub SaveFile()
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim filepath As String
name = "Siemens"
filepath = "F:\Dave backup\Open Orders\Label Manifests\Active Labels Manifest\Manifest Related\File saving testing folder\" & name & "\" & name & " Manifest " & Format(Now, "mm-dd-yyyy")
If fso.DriveExists("F:\") = True Then
'ActiveWorkbook.SaveAs filename:="C:\Users\dgray\Documents\" & name & " Manifest " & Format(Now, "mm-dd-yyyy")
'ActiveWorkbook.SaveAs filename:="F:\Dave backup\Open Orders\" & name & "\" & name & " Manifest " & Format(Now, "mm-dd-yyyy")
ActiveWorkbook.SaveAs filename:=filepath
Else
'ActiveWorkbook.SaveAs filename:="C:\Users\dgray\Documents\" & name & " Manifest " & Format(Now, "mm-dd-yyyy")
ActiveWorkbook.SaveAs filename:="F:\Dave backup\Open Orders\Label Manifests\Active Labels Manifest\Manifest Related\File saving testing folder\" & name & "\" & name & " Manifest " & Format(Now, "mm-dd-yyyy")
End If
End Sub
Here is the error I am getting:
I don't know if you can see but the last part of the error message says "\Siemens\8E555720. That should also say the customer name (i.e. Siemens). In the code I have set the customer name in the variable "name". So why is it giving me this crazy error? All help is appreciated.
Something like this might be better:
Sub SaveFile()
Const PATH_C As String = "C:\Users\dgray\Documents\"
Const PATH_F As String = "F:\Dave backup\Open Orders\Label Manifests\" & _
"Active Labels Manifest\Manifest Related\File saving testing folder\"
Dim fileName As String, custName As String
custName = "Siemens"
fileName = custName & " Manifest " & Format(Now, "mm-dd-yyyy") & ".xlsx" 'or .xlsm
ActiveWorkbook.SaveAs fileName:=PATH_C & fileName 'assume C is always available
'save to F if available
If Len(Dir(PATH_F)) > 0 Then
'assumes the custName folder already exists...
ActiveWorkbook.SaveAs fileName:=PATH_F & custName & "\" & fileName
End If
End Sub
I can see the space in folder name which may cause this error.
By removing space in the foldername this error would be fixed.

Saving files to Onedrive Folder in File Explorer

I'm trying to save a file to an Onedrive folder that syncs within file explorer. Do I need a network path for this to work properly? This is what I have so far:
Sub Macro4()
Dim myDir, strFilename, strPathname, strDateTime As String
strDateTime = " (" & Format(Now, "hhmm AM/PM") & ")"
myDir = Environ("USERPROFILE") & "\Folder 1\Folder2\Folder3\" & Worksheets("Private").Range("L5").Value
strFilename = Worksheets("HWR DATA - Craft").Range("C1").Value
strPathname = myDir & "\" & strFilename
MyMkDir myDir & "\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPathname & strDateTime & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
L5 refers to a cell that contains the following data:
Folder A\Folder B\Folder C
I found the issue. The problem was with my code running into a problem with Microsoft's max length for the path to my folder. (256-character limit for creating links to other files).

Attach certain files

I want to build the following:
select sheets for pdf printing - works
create folder and print sheets - works
attach those printed files to an email - doesn't work
the filename depends on cell values + Date (last Range.Value in filename), is there a way to get those pdfs attached?
I tried the following, but that doesn't work
'code ...
Dim myDir as String, mySht as String
myDir = "C:\Users\ihlin\OneDrive\Düngung\" & Worksheets("Drip_Drain_Eingabe").Range("s13").Text
mySht = Worksheets("Druckansicht_mmol").Range("c2").Text & "_" & Worksheets("Druckansicht_mmol").Range("K2").Text & "_" & Worksheets("Druckansicht_mmol").Range("P2").Text & "_" & "mmol_" & Worksheets("Druckansicht_mmol").Range("T1").Text
`code ... ...
If CheckBox1 = True Then
.Attachments.Add myDir & "\" & mySht & ".pdf"
End if
If CheckBox2 = True Then
.Attachments.Add myDir & "\" & mySht2 & ".pdf"
If CheckBox1 = True Then
.Attachments.Add myDir & "\" & mySht3 & ".pdf"
End if
If CheckBox1 = True Then
.Attachments.Add myDir & "\" & mySht4 & ".pdf"
End if
Publishing takes forever and ends with crashing Excel.
Any help would be appreciated.
Here is a simple debugging method. Try the following:
.Attachments.Add "c:\somehardcoded\address\ofthe\worksheet\folder\file.pdf"
If it works, then super, you simply have to find a way to represent the folder.
If it does not work, then forget it and try to attach the file in another way.

Error 1004 in my Macro while saving a Excel workbook as a CSV for Japanese

I have written a simple Macro for saving all the Workbooks as separate CSV files.
This works fine on my local machine (English Lang) for paths like *D:\MyFolder* .
But when I am trying the same Macro on another windows machine with Japanese language enabled I am getting 1004 error for SaveAS method.
File paths like D:¥MyFolder¥
Below is the my code which is causing the error:
pathSeperator = Application.PathSeparator
strPath = InputBox("Enter EXISTING Directory path like
d:\someDirectoryName, d:", , , 1000)
SaveToDirectory = strPath & pathSeperator & "csv" & pathSeperator
If Dir(strPath & pathSeperator & "csv", vbDirectory) = "" Then
fso.CreateFolder SaveToDirectory
Else
fso.DeleteFolder strPath & pathSeperator & "csv"
fso.CreateFolder SaveToDirectory
End If
For Each WS In ThisWorkbook.Worksheets
newName = WS.Name & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hhmmss")
WS.Copy
ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSVMSDOS, Local:=True
ActiveWorkbook.Close Savechanges:=False
Next
On the Japanese language machine have you tried changing the font on the visual basic editor to Japanese fonts?
This can be done from the tool->options->format tab.
Edit 22/08/13
A bit of a longshot, but I've read that the Japanese Yen character in ASCII is the same as the / charcter on english language machines, as such using Chr(92) should work in both. On an English language machines it would appear as / whislt on a Japanese machine it would have the yen symbol. A simple test would be to run the following macro on a Japanese machine and see what happens.
Sub TestSeperator()
MsgBox Chr(92)
End Sub
If this is the case then you need to make changes like the ones below:
SaveToDirectory = strPath & Chr(92) & "csv" & Chr(92)
If Dir(strPath & Chr(92) & "csv", vbDirectory) = "" Then
fso.CreateFolder SaveToDirectory
Else
fso.DeleteFolder strPath & chr(92) & "csv"
fso.CreateFolder SaveToDirectory
I have tried out your code on my English language machine and managed to raise a 1004 error when I entered the directory path including the final "\"
I have modified the code so that it adds the path seperator if it is not present and the rest of the code assumes it is already in strPath.
pathSeperator = Application.PathSeparator
strPath = InputBox("Enter EXISTING Directory path like d:\someDirectoryName, d:", , , 1000)
Set fso = New FileSystemObject
If Right(strPath, 1) <> pathSeperator Then 'added if clause
strPath = strPath & pathSeperator
End If
SaveToDirectory = strPath & "csv" & pathSeperator 'Removed one pathSeperator
If Dir(strPath & pathSeperator & "csv", vbDirectory) = "" Then
fso.CreateFolder SaveToDirectory
Else
fso.DeleteFolder strPath & "csv" 'Removed one pathSeperator
fso.CreateFolder SaveToDirectory
End If
For Each WS In ThisWorkbook.Worksheets
newName = WS.Name & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hhmmss")
WS.Copy
ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSVMSDOS, Local:=True
ActiveWorkbook.Close Savechanges:=False
Next

Resources