Conversions‎ > ‎

CSVs to WBs

                                         Sample File:  CSVsToWBs.xls        

 
 
PROBLEM: "I have a folder full of CSV files (or TXT files) that I would like to convert to Excel files."
 
SPECIFICATIONS:
  1. User can indicate the type of file to convert to Excel format
  2. All the files are in a specified folder
  3. User can indicate whether original files are deleted, moved, or left in place
  4. If files are moved, the Make Folders (UDF function) is used to insure the destination exists
  5. If a file has already been converted once, the macro will replace/update with the new conversion

CODE

Option Explicit

Sub CSVsToWorkbooks()
'Jerry Beaucaire,   7/12/2010
'Process all files in a folder using parameters from an editable setup sheet
'Uses the MakeFolders function to insure moved destination exists
'Download that function and place in same module
Dim fPath  As String, fPathDONE As String, fCOUNT As Long
Dim fName  As String, fType     As String
Dim fAfter As String, NwName    As String

With Sheets("Setup")
    fPath = .[B1]
        If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    fType = .[B2]
        If fType = "" Then Exit Sub
    If fType <> "txt" And fType <> "csv" Then _
        If MsgBox("The filetype entered is not TXT or CSV, proceed anyway?", _
                                        vbYesNo) = vbNo Then Exit Sub
    fAfter = .[B3]
    If .[B4] <> "" Then
        fPathDONE = .[B4]
        MakeFolders fPathDONE
    End If
End With

fName = Dir(fPath & "*." & fType)   'get first filename
Application.ScreenUpdating = False  'speed up macro
Application.DisplayAlerts = False

Do While Len(fName) > 0             'process file(s) until done
    NwName = Left(fName, InStrRev(fName, ".") - 1)  'the new name
    Workbooks.Open fPath & fName    'open the original file
    ActiveSheet.Name = NwName       'rename the sheet
    ActiveWorkbook.SaveAs fPath & NwName & ".xls", FileFormat:=xlNormal
    ActiveWorkbook.Close            'close the new file
   
    Select Case fAfter
        Case "Delete Original File"
            Kill fPath & fName
        Case "Move Original File"
            Name fPath & fName As fPathDONE & fName
    End Select
       
    fCOUNT = fCOUNT + 1
    fName = Dir()                   'get next filename
   
Loop
   
MsgBox "A total of " & fCOUNT & " files were processed"
Application.ScreenUpdating = True
End Sub



Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!

Comments