trouble with 2010 save as dbf - vba

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)

Related

excel vba doesnt follow save path and saves in my documents

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

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!

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

Set Excel protect properties From HTA

How do I use the following in a vbscript on HTA.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
If I try the same with ":=" , it throws page error.
Thanks,
Anand
To 'port' VBA code like
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
to VBScript to be used in .HTAs (host: mshta.exe) or .VBSs (host c/wscript.exe) you have to
Create an Excel.Application COM object
Use that and it's Workbook/Worksheet collections to drill down to the object you want to call the method on
Convert the named arguments of VBA to positional arguments of VBScript (based on the docs for that method)
Define the xlXXXX constants
Start your research here.
I found an alternative way. I Inserted the required code into VB code module of the object Excel.
Something like below.
With myReport.VBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines .CountOfLines + 1, _
"Private Sub Workbook_Open()" & Chr(13) & _
" ProtectMe(1)" & vbNewLine & _
"End Sub" & vbNewLine & _
"Sub ProtectMe(Status)" & vbNewLine & _
" Dim mySheet As Worksheet" & vbNewLine & _
" Dim myPassword " & vbNewLine & _
" myPassword = ""IamGenius""" & vbNewLine & _
" For Each mySheet In ThisWorkbook.Worksheets" & vbNewLine & _
" mySheet.Protect Password:=myPassword, DrawingObjects:=True, _" & vbNewLine & _
" Contents:=True, Scenarios:=True, AllowFormattingCells:=True, _" & vbNewLine & _
" AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True" & vbNewLine & _
" mySheet.EnableSelection = xlUnlockedCells" & vbNewLine & _
" Next mySheet" & vbNewLine & _
"End Sub"
End With
Thanks,
Anand:)

Insert VBA into formula formatting?

Really quick question on how to format VBA in excel formulas. When you are inserting a formula into excel and you want to insert a variable from vba for example if b is a string you would use " & b & " is that the correct formatting? To illustrate the problem I have the code below and tried to use that formatting and well... I don't know why it wont work, I get a (Compile error: Expected: End of statement). Can anyone tell me where I am going wrong?
Dim HrsSTD As String
Dim HrsSAT As String
Dim HrsSUN As String
Dim HrsSTWN As String
Dim sdFormula
HrsSTD = ActiveCell.Address
Selection.Offset(0, 1).Select
HrsSAT = ActiveCell.Address
Selection.Offset(0, 1).Select
HrsSUN = ActiveCell.Address
Selection.Offset(0, 1).Select
HrsSTWN = ActiveCell.Address
sdFormula = "=IF((" & Range(NamedRange).Cells(2, 1).Address & _
"=""Please add a title"",0,VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)* _
" & HrsSTD & "+VLOOKUP(" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)* _
" & HrsSAT & "*1.25+VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)*" & HrsSUN & "* _
1.5+VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)*" & HrsSTWN & "*0.75)"
The code I would type into excel would be: But I want to change the A13's and the I16 (i.e. all the relative references) into variables in VBA
=IF(A13="Please add a title",0,VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*F16+VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*G16*1.25+VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*H16*1.5+VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*I16*0.75)
Is this what you are trying? Also I see that you haven't taken my advice from the previous answer.
One more tip. Break you code in simple parts. It is easier to understand.
The problem with your code is in the line
",'Tables (H)'!$H$2:$J$6,2,FALSE)* _
" & HrsSAT & "*1.25+VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
You can't write it like that. The first line doesn't have the ending ". You cannot carry it forward to the next line like that.
is this what you are trying?
Dim sFormula As String
Dim sAddr As String
sAddr = Range(NamedRange).Cells(2, 1).Address
sFormula = "=IF(" & sAddr & _
"=""Please add a title"",0,VLOOKUP(" & _
sAddr & ",'Tables (H)'!$H$2:$J$6,2,FALSE)*F16+VLOOKUP(" & _
sAddr & ",'Tables (H)'!$H$2:$J$6,2,FALSE)*G16*1.25+VLOOKUP(" & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)*H16*1.5+VLOOKUP(" & _
sAddr & ",'Tables (H)'!$H$2:$J$6,2,FALSE)*I16*0.75)"