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.
Related
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
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.
I have created an application using excel macro, where the user feeds certain values and saves it to several directory path with a button click macro.
When I select a region from drop down, it should save the file to designated region folder. Say for eg, when NY is selected, the file will be saved to shared drive and 2016 - NY folder. But now, deciding the future of the application, I am thinking of having "year" as a separate field in the worksheet, which retrieves the year value from the user. How do I achieve this without the necessity to change the code every year. The process will be continuing for 'n' number of years from now. Thanks in Advance !
FileName1 = Range("D3").Value
filenameOfNewBook = FileName1
If location = "Illinois" Then
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\Illinois\" & FileName1 & "-" & "checklist" & ".xlsm"
ElseIf location = "LA" Then
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\LA\" & FileName1 & "-" & "checklist" & ".xlsm"
ElseIf location = "NY" Then
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\NY\" & FileName1 & "-" & "checklist" & ".xlsm"
Else
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\Atlanta\" & FileName1 & "-" & "checklist" & ".xlsm"
End If
MsgBox "File Saved successfully!", , "Save"
ActiveWorkbook.save
Application.DisplayAlerts = True
From my experience for office tasks purpose, it's better not to refer to current year, but year set by user, so for example in January 2017 user can still perform actions on files related to 2016. You can get rid of the following:
If location = "Illinois" Then
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\Illinois\" & FileName1 & "-" & "checklist" & ".xlsm"
ElseIf location = "LA" Then
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\LA\" & FileName1 & "-" & "checklist" & ".xlsm"
ElseIf location = "NY" Then
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\NY\" & FileName1 & "-" & "checklist" & ".xlsm"
Else
ActiveWorkbook.SaveAs FileName:="W:\Audits\2016\Atlanta\" & FileName1 & "-" & "checklist" & ".xlsm"
End If
And instead use:
Dim myYear as String, locations() as String, locationForPath as String
Dim locCounter as Long
myYear = ThisWorkbook.Worksheets("Sheet1").Range("a2").value2 'the cell with year value, for example 2016
locations = Split("Illinois,LA,NY",",")
For locCounter = LBound(locations) to UBound(locations)
If location = locations(locCounter) Then locationForPath = location: Exit For
Next locCounter
If locationForPath = vbNullString Then locationForPath = "Atlanta"
ActiveWorkbook.SaveAs FileName:="W:\Audits\" & myYear & "\" & locationForPath & "\" & FileName1 & "-" & "checklist" & ".xlsm"
This will be my first question on this site, so bear with me.
So, I am trying to utilize the ExecuteExcel4Macro function, to reference a value in a different workbook, without having to open the workbook, as it will have to loop through a lot of workbooks in a directory, and reference the same cell on each workbook.
The problem arisen on this line:
wbRef = "'" & folderName & "[" & myDir & "]" & thatSheet & "'!"
which leads to the run-time error 1004 on this line:
month = CStr(ExecuteExcel4Macro(wbRef & Range("D4").Address(, , xlR1C1)))
If, let's say,
folderName = "C:\test\Accounts\O'Malley\Summary\"
, the error occurs.
Since folderName contains an apostrophe, ExecuteExcel4Macro is not recogninzing wbRef as what it is, a path to a folder, but closing that path too early in the path string, therefore resulting the error.
So my question is:
Is there a way to get around this apostrophe, without having to change the folder names, without having to open each individual workbook in the subfolder?
I've tried with double quotations, but didn't seem to do the trick.
Below is a draft of my code, or at least the context.
Sub refMonth()
Dim thisWb as Workbook, folderName as String, myDir as String, wbRef as String, thatSheet as String, month as String
Set thisWb = ActiveWorkbook
folderName = SelectFolder(thisWb)
If folderName = vbNullString Then GoTo Done
myDir = Dir(folderName & "*.xls")
thatSheet = "Sheet1"
wbRef = "'" & folderName & "[" & myDir & "]" & thatSheet & "'!"
Do Until myDir = vbNullString
month = CStr(ExecuteExcel4Macro(wbRef & Range("D4").Address(, , xlR1C1)))
'Do a lot of stuff, which works when in a folder without an apostrophe
myDir = Dir()
wbRef = "'" & folderName & "[" & myDir & "]" & thatSheet & "'!"
Loop
Done:
End Sub
Function SelectFolder(thisWb As Workbook)
Dim diaFolder As FileDialog, DirName As Variant
' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.InitialFileName = strFolder(thisWb.Path)
If diaFolder.Show = True Then
'diaFolder.Show
DirName = diaFolder.SelectedItems(1)
If Right(DirName, 1) <> "\" Then
DirName = DirName & "\"
End If
Else
Set diaFolder = Nothing
Exit Function
End If
Set diaFolder = Nothing
SelectFolder = DirName
End Function
Function strFolder(ByVal strFolder0) As String
strFolder = Left(strFolder0, InStrRev(strFolder0, "\") - 1) & "\"
End Function
Any help is appreciated, even if it's just to tell me it's impossible to get around the apostrophe.
I couldn't find an answer on here, but if there is one, please point me in the right direction.
You need to double the apostrophe to escape it:
wbRef = "'" & Replace$(folderName & "[" & myDir & "]" & thatSheet, "'", "''") & "'!"
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_"