VBA: saving to specific path based on cell values - vba

I made a macro to save an Excel file on a location based on some cell values.
But when I run the macro the file won't save.
The last line of the macro becomes yellow.
If I skip the dtMonth and dtMonthnumber the files saves just fine, so the problem is not dtYear, or Format(dtDate, "yymmdd").
Do I need to concert the cell values?
The formulas in the cells are to convert date to month and year:
U1 =TEXT(Controle!H6;"mmmm")
U2 =TEXT(Controle!H6;"jjjj")
U3 =TEXT(H6;"mm")
Dim dtDate As Date
dtDate = Date
Dim dtMonth As String
Dim dtYear As String
Dim dtMonthnumber As String
dtMonth = ThisWorkbook.Sheets("Controle").Range("U1")
dtYear = ThisWorkbook.Sheets("Controle").Range("U2")
dtMonthnumber = ThisWorkbook.Sheets("Controle").Range("U3")
Dim strFile As String
strFile = "M:\X-tra pakketten\" & dtYear & "\" & dtMonthnumber & " - " & dtMonth & "\" & Format(dtDate, "yymmdd") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=strFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Sounds like a VBA bug, where Breakpoints are sometimes not properly deleted. Try this:
Set a Breakpoint somewhere inside your procedure.
Change something inside your code, so it needs to recompile (for example add a Debug.Print "" somewhere)
Use the menu Debug > Delete all breakpoints (Ctrl+Shift+F9)
Recompile it
That should solve the problem. If it still doesn't work, copy your code somewhere, delete the module, create a new module and insert the code again.

Related

VBA SaveCopy function + lose a worksheet

I created an Excel 2016-based template, which the user can fill and create a work form based on it. User inserts an unique ID and with basic INDEX&MATCH formulas some ID-related parameters are being fetched from separate worksheet a. The work form is created with VBA-macro using SaveCopyAs method.
After the parameters have been fetched and VBA is launched to create the work form the ID will not change anymore. Thus, I don't need the whole worksheet a anymore and would like to drop it to keep the work form more lightweight. I'm capable of retaining the fetched parameters, so this is not a problem.
I would NOT want the user to have to re-open the form every single time a work form is created, so I don't want the VBA to remove worksheet a from the template itself, as even though the user can't save changes to the template, (s)he would have to re-open the template file every time a work form has to be created.
Any idea if something could be done? Might it be possible to somehow run SaveCopyAs or similar method, but drop the worksheet a at the same time from the new target file? Having INDEX&MATCH formula fetch the needed information from another workbook would theoretically work but to my knowledge requires the other workbook to be open at all times which will undoubtedly start to cause unnecessary issues.
My current VBA for work form creating is something like this:
Sub Save_copy()
Dim FileName As String
With ActiveWorkbook
[H3] = Format(Now, "dd.mm.yy_hhmm")
Range("H2").Value = Range("H1").Value
FileName = "SERVICE " & _
Range("H1").Value & _
" - " & Format(Now, "dd.mm.yy") & _
"_" & Format(Now, "hhmm") & _
"." & Right(.Name, Len(.Name) - InStrRev(.Name, "."))
.SaveCopyAs "G:\SERVICE" & "\" & FileName
End With
Call Reset
End Sub
If I understood you properly try something like this ("air-coded" so there may be typos):
Sub Save_copy()
Dim FileName As String
With ActiveWorkbook
[H3] = Format(Now, "dd.mm.yy_hhmm")
Range("H2").Value = Range("H1").Value
FileName = "SERVICE " & _
Range("H1").Value & _
" - " & Format(Now, "dd.mm.yy") & _
"_" & Format(Now, "hhmm") & _
"." & Right(.Name, Len(.Name) - InStrRev(.Name, "."))
.SaveCopyAs "G:\SERVICE\" & FileName
End With
Dim newWorkbook As Excel.Workbook
Set newWorkbook = Workbooks.Open("G:\service\" & FileName)
newWorkbook.Worksheets("A").Delete
newWorkbook.Close True
Reset
End Sub
Additionally, a couple of coding tips:
There's no need for Call - that function is deprecated and only exists to keep ancient code from blowing up
There is an extra concatenation of the "\" in your .SaveCopyAs line - simply put the trailing slash in with the rest of the path (as I did).
The unqualified Range("H2") refers to the ActiveWorksheet and could blow up on you if your user ever happens to click on a different worksheet while your code is running

File is not saving to newly made folder in VBA

I have a macro that created a folder by data within a pathway, and I want a cut of a manager roster to be saved in that folder. Since the folder name varies, this needs to be dynamic.
I want it to go something like this:
Dim sPath As String
sPath = "M:\mgr1_TCR_Reports\"
If Len(Dir(sPath & "_" & Format(Date, "mm_dd_yyyy"), vbDirectory)) = 0 Then
MkDir (sPath & "_" & Format(Date, "mm_dd_yyyy"))
End If
End Sub
and saving this like:
.SaveAs Filename:="M:\mgr1_TCR_Reports\" & "_" & Format(Date, "mm_dd_yyyy_") & "\" & Manager, FileFormat:=xlOpenXMLWorkbook, Password:=""
.Close
But I keep getting a runtime 1004: document not saved on ^^^ the second line of code I provided.
Any idea what's going on?

Dynamically Change pivot table source data

I have a pivot table within an Excel 2010 workbook and the source changes everyday and gets outputed onto another excel workbook with name format as: "filename_MM.DD.YYYY.xlsx"
I have tried the following
Set ws1 = Worksheets("GRAPH")
Set ws2 = Worksheets("COC")
Set ws3 = Worksheets("LC")
Dim file_path As String
Dim file_name As String
Dim year As String
Dim day As String
Dim month As String
Dim project As String
Dim full_name As String
file_path = Sheets("Master").Range("F" & rep1).Value
file_name = Sheets("Master").Range("G" & rep1).Value
output_sheet = Sheets("Master").Range("L" & rep1).Value
year = Sheets("Master").Range("M" & rep1).Value
month = Format(Sheets("Master").Range("I" & rep1).Value, "00")
day = Format(Sheets("Master").Range("L" & rep1).Value, "00")
project = Sheets("Master").Range("B1").Value
full_name = Sheets("Master").Range("N10").Value
ws1.Activate
ActiveSheet.PivotTables("PivotTable2").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"\\JLR1GBMDCZZZB5J\SebServer\BOM_CAD_SCRIPT\project\2016\06 \22\full_name BOM'!$D:$CC" _
, Version:=xlPivotTableVersion15)
Next rep1
So the full_name is the full name of the file, project is the name of the folder and so on. This is all located in a sheet called 'Master' and pulls in the data from there.
But when changing the data source it does not work.
The source will change everyday and will be in a new folder with the new date every day, once a day.
Please Help
Thank you
The SourceData argument you have in your code is:
SourceData:="\\JLR1GBMDCZZZB5J\SebServer\BOM_CAD_SCRIPT\project\2016\06 \22\full_name BOM'!$D:$CC"
As this is all contained in "" you are passing this whole argument as a single string word for word every time you run your code without any change. I can see that within this you have written the names of a couple of your variables in attempt to change this value each time you run your code, in order to achieve this you need to append this like so:
SourceData:="\\Start of the filepath\" & aVariableFromYourMacro & "\end of the filepath"
in your case you are looking for something like the following:
SourceData:="\\JLR1GBMDCZZZB5J\SebServer\BOM_CAD_SCRIPT\" & project & "\" & year & "\" & month & "\" & day & "\" & full_name & " BOM'!$D:$CC"
In this example I have placed your variables in where the project, full_name and date labels were in the original string. You may need to modify this to get it to work how you like however hopefully from this example you can understand what you need to do.

Create new folder if path doesn't exist (else paste in existing folder)

I've made an Excel sheet which processes data to a Sheet and Saves it as a new workbook in a certain Folder - Subfolder (named like the first part of the file names).
The code works fine but I'd like to make a new folder if the required path does not exists. Should definitely be possible to achieve with an 'If' function, but I don't know how to create new folders.
Note: skipped some part in the code below, to keep it short I only past the parts worth mentioning.
Sub SaveSheetAs()
Dim sMainFolder as String
Dim sFileName as string
Dim sSubFolder as string
sMainFolder = Z:\Parts Manufacturing\5. Kwaliteit\130 - in proces meten\EindProject\Bron '(Main folder, which isn't variable)
sFileName = 4022 646 68954#1234 '(Part name with Unique number)'variable number, in de real code this number is received by refering to a range("")
sSubFolder = 4022 646 68954 '(variable number, in de real code this number is received by refering to a range("")
ActiveWorkbook.SaveAs Filename:=sMainFolder & "\"& sSubFolder & "\" & sFileName & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
end sub
Here you go :
If Dir(sMainFolder & "\"& sSubFolder & "\", 16) <> vbNullString Then
Else
MkDir (sMainFolder & "\"& sSubFolder & "\")
End If

Export As A Fixed Format Excel 2007

I have been assigned the task of developing a excel document that whole office will use. The user will click a button and the macro will export the file as a PDF to a shared folder. I wrote this code and tested this code using excel 2010. People that have excel 2007 where getting an error message saying "Run Time Error 1004 Document not saved. This document may be open, or an error may have been encountered when saving." I looked into the problem a little bit and found that excel 2007 needed an add-in update, so I installed it on their computers. I also checked to see if they have adobe on their computers and they do. They are still having the problem and I am unsure of what to do. Any help would be greatly appreciated!
Here is my code
' Define all variables
Dim strFileName As String
Dim folder As String
Dim member As Integer
Dim member_count As Integer
Dim member_name As String
Dim show As Variant
Dim MyTime As String
'Save as new file
Worksheets("Input data").Visible = True
folder = Sheets("Input data").Range("location").Value
MyTime = Time
Sheets("Input data").Select
Range("G2").Value = MyTime
strFileName = folder & "Material Request - " & Sheets("Input data").Range("name").Value & "_" & Sheets("Input data").Range("date").Value & " " & Sheets("Input data").Range("time").Value & ".pdf"
Sheets("Material Request").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName 'OpenAfterPublish:=True`
You should start with changing the code to remove .Select & .ActiveSheet instances.
Dim oWS as Worksheet
Set oWS = ThisWorkbook.Worksheets("Input data")
' Worksheets("Input data").Visible = True
folder = oWS.Range("location").Value
If Right(folder,1) <> Application.PathSeparator Then folder = folder & Application.PathSeparator
MyTime = Time
' Sheets("Input data").Select
oWS.Range("G2").Value = MyTime
strFileName = folder & "Material Request - " & oWS.Range("name").Value & "_" & oWS.Range("date").Value & " " & oWS.Range("time").Value & ".pdf"
Debug.Print "strFileName: " & strFileName
'Sheets("Material Request").Select
oWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName 'OpenAfterPublish:=True`
Set oWS = Nothing
Refer to this MSDN Worksheet.ExportAsFixedFormat Method, you may need fill in more parameters depending on properties of the Worksheet "Input Data".
I have added some checks and refer to Immediate window to check value of strFileName in 2007.
I had a similiar problem (Error 1004 when attempting export). After an hour of pulling my hair out, here was the source of my problem.
I was passing a cell value as part of generating the filename. I was doing this in the format of
fileName:= ActiveWorkbook.Path & "\" & CStr(Workbooks.Cells(i,j).Value) & ".pdf"
The text in the cell itself was formatted to be in two rows (i.e. "top row text" + (Alt+K) + "bottom row text"). While the string looks normal in Debug.print, MsgBox, or value previews, I am thinking that there is a hidden character which encodes the new line for the cell. I believe this hidden character causes the error when passed as part of the fileName argument. I'm guessing Excel doesn't pick it up but the OS's file name system does.
In any case, this fixed the issue for me.