excel vba doesnt follow save path and saves in my documents - vba

I am quite new to vba. I wrote a piece of code to save an excel workbook. the original save path works and the file gets saved there, but when i try to change it (to a shared directory) it doesn't listen.Instead, it just saves in My Documents. Below is the code that works.
Any help would be appreciated
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ChDir "C:\Users\SI\Desktop\Generator"
ActiveWorkbook.SaveAs Filename:= _
Range("B4").Value & " TRS - " & Range("E6").Value & " vs " _
& Range("E7").Value & " - " & Format(Date, "dd-mm-yyyy"), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("ST").Select

Just specify the full path in the Filename argument for the SaveAs
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\SI\Desktop\Generator\" & Range("B4").Value & " TRS - " & Range("E6").Value & " vs " _
& Range("E7").Value & " - " & Format(Date, "dd-mm-yyyy"), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("ST").Select

Related

Save a single worksheet as CSV/xlsx file error 1004 (but does work when use 'export as fixed format' for PDF)

I have managed to get this to save as a PDF using 'ExportAsFixedFormat', but when I try to use 'SaveAs' to get a CSV (although I would accept xlsx too!) I get:
Run time error: 1004 Application defined or Object defined error
I have spent way to long trying to do this and can't find any answers that work for me online...
Sub SaveTrackingSheet()
Dim NewPathTrack As String
NewPathTrack = Application.ThisWorkbook.Path & "\PDF Outputs\" & Range("NameTrack").Text & "\"
If Dir(NewPathTrack, 63) = "" Then MkDir NewPathTrack
Dim NewPathDealer As String
NewPathDealer = NewPathTrack & Range("CodeTrack").Text & " - " & Range("NameTrack").Text & "\"
If Dir(NewPathDealer, 63) = "" Then MkDir NewPathDealer
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & "\" & Range("CodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
ConflictResolution:=2, _
Local:=True, _
CreateBackup:=False
End Sub
This is the line that errors:
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & "\" & Range("DealerCodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
ConflictResolution:=2, _
Local:=True, _
CreateBackup:=False
Thanks in advance!
fileformat:=xlCSVMSDOS
Check fileformat specifications at https://msdn.microsoft.com/es-es/vba/excel-vba/articles/xlfileformat-enumeration-excel
UPDATED RIGHT NOW:
The code that works for me is:
Sub SaveTrackingSheet()
Dim NewPathTrack As String
NewPathTrack = Application.ThisWorkbook.Path & "\PDF Outputs\" & Range("NameTrack").Text & "\"
If Dir(NewPathTrack, 63) = "" Then MkDir NewPathTrack
Dim NewPathDealer As String
NewPathDealer = NewPathTrack & Range("CodeTrack").Text & " - " & Range("NameTrack").Text & "\"
If Dir(NewPathDealer, 63) = "" Then MkDir NewPathDealer
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & Range("CodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
Local:=True, _
CreateBackup:=False
'ConflictResolution:=2 This line causes the error
End Sub
Hope it helps!

Save version of file to drive, when the drive changes from computer to computer

I made a macro to export my xlsm file into a csv file. It works great on one computer where the directory of the server is "I" but on another computer with the same server saved to directory "T" it fails. Is there a solution to this multi-directory/multi-computer problem? The trimmed code is attached with the directory line pointed out.
Sub ExportAsCSV()
Dim Answer As VbMsgBoxResult, Dir As String, LastRow As Long, _
Date1 As Date, Date2 As Date, CSVFileName As String
' *********************************************************
' Directory String <---------------- The Issue
Dir = "I:\2017\CVS" ' Could be "I:\", could be "T:\" ...
' *********************************************************
' Creating the Name of the CSV File using the _
' first and last date in column C (C1 is a header)
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Date1 = Range("C2").Value
Date2 = Cells(LastRow, "C")
If Date1 < Date2 Then
CSVFileName = "FILE." & Format(Date1, "mm.dd.yy") & _
"-" & Format(Date2, "mm.dd.yy") & ".csv"
ElseIf Date1 > Date2 Then
CSVFileName = "FILE." & Format(Date2, "mm.dd.yy") & _
"-" & Format(Date1, "mm.dd.yy") & ".csv"
Else
CSVFileName = "FILE." & Format(Date1, "mm.dd.yy") & ".csv"
End If
' Double Check User wants to make a sheet Response
Answer = MsgBox("Clicking 'Yes' will create a CSV file named " & vbCrLf & vbCrLf & _
" " & CSVFileName & vbCrLf & vbCrLf & _
"into " & vbCrLf & vbCrLf & " " & Dir & vbCrLf & vbCrLf & _
"It will overwrite any CSV with an identical name." & vbCrLf & vbCrLf & _
"Is this what you want to do?", vbYesNo + vbQuestion)
'Act based on the Response
If Answer = vbYes Then
' Ready all cells for csv creation
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
ws.Copy
ActiveWorkbook.SaveAs FileName:=Dir & "\" & CSVFileName, _
FileFormat:=xlCSV, CreateBackup:=False
MsgBox ("Created the csv file:" & vbCrLf & vbCrLf & _
Dir & "\" & CSVFileName)
Else
MsgBox ("Did not create the csv file.")
End If
End Sub
Any help is appreciated.
You need to use a UNC path instead of a mapped network drive.
Dir = "\\ServerName\SomeFolder\2017\CVS"
If you don't know what server/folder the network drive is pointing to, ask your network administrator.
Side note
You shouldn't name things in ways that hide/shadow identifiers that already exist in global namespace: Dir is actually a function in the VBA.FileSystem module; by declaring a Dir local variable, you make the name potentially ambiguous to the reader (although the compiler doesn't care).

Selecting first row/last row only from saved file to print

I've almost completed my code where I save data, export as pdf, all that jazz. I was wondering if there was a way to incorporate [excel sheet].PageSetup.PrintTitleRows = "$[firstrow]$[lastrow]"; into my program. I'm not sure if this should be manipulated in some way. The first row holds all the units and the report saves data in each row, however, I only want the last row of data (new stuff), but with the unit row (row 1) as well. Here's my code, not entirely sure where it put it (proably near the end):
Sub Save_History()
'copies data from calculation page
Sheets("Simple Calculation").Select
Range("A2:I2").Select
Selection.Copy
Sheets("Media History").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.DisplayAlerts = False`
' Check for year folder and create if needed
If Len(Dir("C:blah\" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False)
End If
' Check for day folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date)
End If
strFilePath = "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & _
Format(Date, "mm.dd.yy") & "_" & Format(Time(), "hh.mm.ssAM/PM") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:=strFilePath, _
Quality:=x1QualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True _
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As:" & vbNewLine & strFilePath
End Sub
Here's what worked (finally) I just Copied/pasted again.
Sub Save_History()
Sheets("Simple Calculation").Select
Range("A2:I2").Select
Selection.Copy
Sheets("New Media Report").Select
Range("A1").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'copies data from calculation page
Sheets("Simple Calculation").Select
Range("A2:I2").Select
Selection.Copy
Sheets("Media History").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.DisplayAlerts = False
' Check for year folder and create if needed
If Len(Dir("C:blah\" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False)
End If
' Check for day folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date)
End If
strFilePath = "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & _
Format(Date, "mm.dd.yy") & "_" & Format(Time(), "hh.mm.ssAM/PM") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:=strFilePath, _
Quality:=x1QualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True _
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As:" & vbNewLine & strFilePath
End Sub

vba saving word file to created folder

I have written the code below, currently it creates a folder. However I would like to save the same word doc to that folder. Any pointers on where I am going wrong??
Thanks
Sub newfold()
Dim strNewFolderName As String
strNewFolderName = "New Folder " & (Month(Now())) & " " & Year(Now)
If Len(Dir("c:\Users\Jabaar\Documents\" & strNewFolderName, vbDirectory)) = 0 Then
MkDir ("c:\Users\Jabaar\Documents\" & strNewFolderName)
End If
Dim PathName As String
PathName = ("New Folder " & MonthName(Month(Now())) & " " & Year(Now))
ActiveDocument.SaveAs "c:\Users\Jabaar\Documents\" & "(strNewFolderName)" + ".doc"
End Sub
Just replace
ActiveDocument.SaveAs "c:\Users\Jabaar\Documents\" & "(strNewFolderName)" + ".doc"
with
ActiveDocument.SaveAs FileName:="c:\Users\Jabaar\Documents\" & strNewFolderName & "\" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
FileFormat:=wdFormatDocument
where Split(ActiveDocument.Name, ".")(0) takes current name of file without extension. You could replace it with desired name:
ActiveDocument.SaveAs FileName:="c:\Users\Jabaar\Documents\" & strNewFolderName & "\" & "newFile.doc", _
FileFormat:=wdFormatDocument
This is what have done and it seems work.
ActiveDocument.SaveAs "c:\Users\Jabaar\Documents\" & strNewFolderName & "\" & "test" + ".doc
The solution #simoco provided is what I was looking for, so thanks for confirming the formatting of it #simoco

trouble with 2010 save as dbf

Below is the code I'm trying to fix. It works in Excel 2007 but not in Excel 2010.
I believe it has to do with the XlDBF4 part. Please help.
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=Range("SetUp!L34") & Range("SetUp!D28") & "_" & Range("SetUp!F28") & ".dbf", FileFormat:= _
xlDBF4, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=Range("Setup!L28") & Range("SetUp!D28") & "_" & Range("SetUp!F28") & " " & Range("SetUp!D30") & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Try this code instead:
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=Range("SetUp!L34") & Range("SetUp!D28") & "_" & Range("SetUp!F28") & ".dbf", FileFormat:= _
xlDBF4, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=Range("Setup!L28") & Range("SetUp!D28") & "_" & Range("SetUp!F28") & " " & Range("SetUp!D30") & ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
I think the case is xlNormal: if you want xls - you should use xlExcel8 instead. It's strange your code works - there's no xlNormal constant at all: XlFileFormat Enumeration (Excel)