VBA/Excel/Access/Word/File Path/CSV

Brings up a dialog box that asks the user for a filename.

 
  Sub GetImportFileName()
      Dim Finfo As String
      Dim FilterIndex As Integer
      Dim Title As String
      Dim FileName As Variant
      FInfo = "Text Files (*.txt),*.txt," & _
              "Lotus Files (*.prn),*.prn," & _
              "Comma Separated Files (*.csv),*.csv," & _
              "ASCII Files (*.asc),*.asc," & _
              "All Files (*.*),*.*"
  "   Display *.* by default
      FilterIndex = 5
      Title = "Select a File to Import"
      FileName = Application.GetOpenFilename(FInfo,FilterIndex, Title)
      If FileName = False Then
          MsgBox "No file was selected."
      Else
          MsgBox "You selected " & FileName
      End If
  End Sub

Create text file based database

 
Sub TextExample()
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim sCS As String
    Dim sSQL As String
    Set cn = New ADODB.Connection
    sCS = "DefaultDir=C:\;"
    sCS = sCS & "Driver={Microsoft Text Driver (*.txt; *.csv)};"
    sCS = sCS & "DriverId=27;"
    cn.ConnectionString = sCS
    cn.Open
    Debug.Print cn.ConnectionString
    On Error Resume Next
    cn.Execute "CREATE TABLE [newfile.txt] (FirstName TEXT, LastName TEXT);"
    If Err.Number <> 0 And Err.Number <> vbObjectError + 3604 Then
        Debug.Print Err.Number & ": " & Err.Description
        Exit Sub
    End If
    sSQL = "INSERT INTO [newfile.txt] (FirstName, LastName) Values ("steve", "roman");"
    cn.Execute sSQL
    Set rs = New ADODB.Recordset
    rs.Open "SELECT * FROM NewFile.txt", cn, adOpenDynamic, adLockOptimistic
    Debug.Print rs.Supports(adAddNew)
    Debug.Print rs.Supports(adBookmark)
    Debug.Print rs.Supports(adDelete)
    Debug.Print rs.Supports(adFind)
    Debug.Print rs.Supports(adUpdate)
    Debug.Print rs.Supports(adMovePrevious)
    
    rs.Close
    cn.Close
End Sub

Export active worksheet to CSV file

 
Sub ExportActiveWorksheet()
  Dim oldname$, oldpath$, oldformat
  Application.DisplayAlerts = False  "avoid safetey alert
  With ActiveWorkbook
    oldname = .Name
    oldpath = .Path
    oldformat = .FileFormat
    .ActiveSheet.SaveAs _
      Filename:="c:\file.csv", FileFormat:=xlCSV
    .SaveAs Filename:=oldpath + "\" + oldname, FileFormat:=oldformat
  End With
  Application.DisplayAlerts = True
End Sub

Query text file

 
Public Sub QueryTextFile()
    Dim Recordset As ADODB.Recordset
    Dim ConnectionString As String
    ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";" & _
      "Extended Properties=Text;"
    
    Const SQL As String = "SELECT * FROM Sales.csv WHERE Type="Art";"
    
    Set Recordset = New ADODB.Recordset
    Call Recordset.Open(SQL, ConnectionString, CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText)
    Call Sheet1.Range("A1").CopyFromRecordset(Recordset)
    Recordset.Close
    Set Recordset = Nothing
End Sub

Saves the active worksheet in the workbook named MyWorkbook.xls as a comma-delimited text file named test.csv:

 
Sub csvSave()
    Workbooks("MyWorkbook.xls").SaveAs Filename:=ActiveWorkbook.Path & _
              "\test.csv", FileFormat:=xlCSV
End Sub

Split demonstration

 
Sub UsefulStringFunctions() 
    Dim sTestWord As String 
    sTestWord = "One, Two, Three, 4, Five, Six" 
    DemoSplit sTestWord 
End Sub 
Sub DemoSplit(sCSV As String) 
    Dim vaValues As Variant 
    Dim nIndex As Integer 
    vaValues = Split(sCSV, ",") 
    For nIndex = 0 To UBound(vaValues) 
        Debug.Print "Item (" & nIndex & ") is " & vaValues(nIndex) 
    Next 
End Sub