Open File as .CSV, Save As .XLS via Macro

[David R]

[SOLVED] Open File as .CSV, Save As .XLS via Macro

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]

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]

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.