View Full Version : Open File as .CSV, Save As .XLS via Macro


David R
07-29-2009, 07:48 AM
I've managed to record a macro that opens a specific .CSV, imports and formats it properly, and then saves it as an .XLS file with the same name. But, I'm unable to discover what the Macro command is for pulling up the Common Dialog. I think I can resave it later as .XLS without much trouble.

Options in VBE are good too, but I don't tweak Excel much so I was unsure how to encode this by hand.

If it helps, here's the macro as it currently stands:
Sub ParcelListingFormat()

Workbooks.OpenText Filename:= _
"\\servername\folder\MarlboroughPride.txt" _
, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), _
Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), Array(7, 9), Array(8, 9), _
Array(9, 9), Array(10, 9), Array(11, 9), Array(12, 9), Array(13, 9), Array(14, 9), Array(15 _
, 9), Array(16, 9), Array(17, 9), Array(18, 9), Array(19, 9), Array(20, 9), Array(21, 9), _
Array(22, 9), Array(23, 9), Array(24, 9), Array(25, 9), Array(26, 9), Array(27, 9), Array( _
28, 9), Array(29, 1), Array(30, 9), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 2), _
Array(35, 9), Array(36, 9), Array(37, 9), Array(38, 9), Array(39, 9), Array(40, 9), Array( _
41, 9), Array(42, 9), Array(43, 9), Array(44, 1), Array(45, 9), Array(46, 9), Array(47, 9), _
Array(48, 9), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
54, 1)), TrailingMinusNumbers:=True
Rows("1:1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "OWNER_NAME2"
Range("A1").Select
ActiveCell.FormulaR1C1 = "OWNER_NAME"
Range("C1").Select
ActiveCell.FormulaR1C1 = "OWNER_CITY"
Range("D1").Select
ActiveCell.FormulaR1C1 = "OWNER_STATE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "OWNER_ZIP"
Range("F1").Select
ActiveCell.FormulaR1C1 = "OWNER_ADDR"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PARCEL"
Range("I1").Select
ActiveCell.FormulaR1C1 = "DIR"
Range("L1").Select
ActiveCell.FormulaR1C1 = "FULL_ADDRESS"
Columns("L:L").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("F:F").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("L1").Select
ActiveCell.FormulaR1C1 = "TYPE"
Columns("G:L").Select
Range("L1").Activate
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Cells.Select
Cells.EntireColumn.AutoFit
Range("A7").Select
ActiveWorkbook.SaveAs Filename:= _
"\\servername\folder\MarlboroughPride.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub(\\servername\folder\ will always be the same, but the filename will be different for each job)

HaHoBe
07-29-2009, 10:33 AM
Hi, David,

have a try with Application.GetOpenFilename:

Sub ParcelListingFormat()

Dim varName As Variant
Dim strAktVerz As String

strAktVerz = CurDir

varName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If varName <> False Then
Workbooks.OpenText Filename:=varName _
, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), _
Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), Array(7, 9), Array(8, 9), _
Array(9, 9), Array(10, 9), Array(11, 9), Array(12, 9), Array(13, 9), Array(14, 9), Array(15 _
, 9), Array(16, 9), Array(17, 9), Array(18, 9), Array(19, 9), Array(20, 9), Array(21, 9), _
Array(22, 9), Array(23, 9), Array(24, 9), Array(25, 9), Array(26, 9), Array(27, 9), Array( _
28, 9), Array(29, 1), Array(30, 9), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 2), _
Array(35, 9), Array(36, 9), Array(37, 9), Array(38, 9), Array(39, 9), Array(40, 9), Array( _
41, 9), Array(42, 9), Array(43, 9), Array(44, 1), Array(45, 9), Array(46, 9), Array(47, 9), _
Array(48, 9), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
54, 1)), TrailingMinusNumbers:=True
Rows("1:1").Font.Bold = True
Range("B1").Value = "OWNER_NAME2"
Range("A1").Value = "OWNER_NAME"
Range("C1").Value = "OWNER_CITY"
Range("D1").Value = "OWNER_STATE"
Range("E1").Value = "OWNER_ZIP"
Range("F1").Value = "OWNER_ADDR"
Range("G1").Value = "PARCEL"
Range("I1").Value = "DIR"
Range("L1").Value = "FULL_ADDRESS"
Columns("L:L").Cut
Columns("G:G").Insert Shift:=xlToRight
Columns("F:F").Cut
Columns("C:C").Insert Shift:=xlToRight
Range("L1").Value = "TYPE"
Columns("G:L").Cut
Columns("A:A").Insert Shift:=xlToRight
Cells.EntireColumn.AutoFit
Range("A7").Select
' ActiveWorkbook.SaveAs Filename:= _
' "\\servername\folder\MarlboroughPride.xls" _
' , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
' ReadOnlyRecommended:=False, CreateBackup:=False
End If

ActiveWorkbook.SaveAs Filename:=Left(varName, Len(varName) - 4) & ".xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

ChDrive Left(strAktVerz, 1)
ChDir strAktVerz

End Sub
Ciao,
Holger

David R
07-29-2009, 12:12 PM
Huh; I saw that and discarded it, as I thought it was just giving you the name of the file you've got open right now. Thanks for setting me straight!

Works a treat now, although strAktVerz threw an error so I just commented it out. This is only for my GIS-capable computer, so I'm not worried about preserving directory memory.