VBA/Excel/Access/Word/File Path/FreeFile

An Example Using Write # and Input #

 
Sub TestWriteInput()
    Dim lOutputFile As Long
    Dim rg As range
    Set rg = ThisWorkbook.Worksheets(1).range("a1")
    lOutputFile = FreeFile
    Open "C:\Write Example.txt" For Output As #lOutputFile
    Do Until IsEmpty(rg)
        Write #lOutputFile, rg.value, _
            rg.Offset(0, 1).value, _
            rg.Offset(0, 2).value, _
            rg.Offset(0, 3).value, _
            rg.Offset(0, 4).value, _
            rg.Offset(0, 5).value, _
            rg.Offset(0, 6).value, _
            rg.Offset(0, 7).value
        Set rg = rg.Offset(1, 0)
    Loop
    Set rg = Nothing
    Close lOutputFile
    Dim lInputFile As Long
    Dim v1, v2, v3, v4
    Dim v5, v6, v7, v8
    Set rg = ThisWorkbook.Worksheets(2).range("a1")
    rg.CurrentRegion.ClearContents
    lInputFile = FreeFile
    Open "C:\Write Example.txt" For Input As lInputFile
    Do Until EOF(lInputFile)
        Input #lInputFile, v1, v2, v3, v4, v5, v6, v7, v8
        rg.value = v1
        rg.Offset(0, 1).value = v2
        rg.Offset(0, 2).value = v3
        rg.Offset(0, 3).value = v4
        rg.Offset(0, 4).value = v5
        rg.Offset(0, 5).value = v6
        rg.Offset(0, 6).value = v7
        rg.Offset(0, 7).value = v8
        Set rg = rg.Offset(1, 0)
    Loop
    Set rg = Nothing
    Close lInputFile
End Sub

Examples of the VBA Open Statement

 
Sub SimpleOpenExamples() 
    Dim lInputFile As Long 
    Dim lOutputFile As Long 
    Dim lAppendFile As Long 
    lInputFile = FreeFile 
    Open "C:\MyInputFile.txt" For Input As #lInputFile 
    lOutputFile = FreeFile 
    Open "C:\MyNewOutputFile.txt" For Output As #lOutputFile 
    lAppendFile = FreeFile 
    Open "C:\MyAppendFile.txt" For Append As #lAppendFile 
    Close lInputFile, lOutputFile, lAppendFile 
End Sub

Flexible Separators and Delimiters

 
     Sub WriteStringsWithDelimiters()
         Dim sLine As String
         Dim sFName As String    "Path and name of text file
         Dim iFNumber As Integer    "File number
         Dim lRow As Long     "Row number in worksheet
         Const sVS As String = ";"   "Variable separator character
         Const sTD As String = """"  "Text delimiter character
         Const sDD As String = "#"    "Date delimiter character
         sFName = "C:\Delimited.txt"
         iFNumber = FreeFile
         Open sFName For Output As #iFNumber
         lRow = 2
         Do
             With Sheet1
               sLine = sDD & format(.cells(lRow, 1), "yyyy-mmm-dd") & sDD & sVS
               sLine = sLine & sTD & .cells(lRow, 2) & sTD & sVS
               sLine = sLine & sTD & .cells(lRow, 4) & sTD & sVS
               sLine = sLine & format(.cells(lRow, 6), "0.00")
             End With
             Print #iFNumber, sLine
             lRow = lRow + 1
         Loop Until IsEmpty(Sheet1.cells(lRow, 1))
         Close #iFNumber
     End Sub

Handling Files with Low-Level File Handling

 
Sub LogErrorText()
    Dim intFile As Integer
    intFile = FreeFile
    Open CurDir & "\ErrorLog.Txt" For Append Shared As intFile
    Write #intFile, "LogErrorDemo", Now, Err, Error, CurrentUser()
    Close intFile
End Sub

Reading Data Strings

 
     Sub ReadStrings()
           Dim sLine As String
           Dim sFName As String    "Path and name of text file
           Dim iFNumber As Integer    "File number
           Dim lRow As Long     "Row number in worksheet
           Dim lColumn As Long  "Column number in worksheet
           Dim vValues As Variant "Hold split values
           Dim iCount As Integer  "Counter
           sFName = "C:\Strings.txt"
           iFNumber = FreeFile
           Open sFName For Input As #iFNumber
           Do
           Line Input #iFNumber, sLine
           vValues = Split(sLine, ";")
           For iCount = LBound(vValues) To UBound(vValues)
              Debug.Print  vValues(iCount)
           Next iCount
           Close #iFNumber
     End Sub

Text Files and File Dialog

 
     Sub WriteFile()
         Dim dDate As Date
         Dim sCustomer As String
         Dim sProduct As String
         Dim dPrice As Double
         Dim sFName As String    "Path and name of text file
         Dim iFNumber As Integer    "File number
         Dim lRow As Long     "Row number in worksheet
         sFName = "C:\Sales.txt"
         iFNumber = FreeFile
         Open sFName For Output As #iFNumber
         lRow = 2
         Do
             With Sheet1
                 dDate = .cells(lRow, 1)
                 sCustomer = .cells(lRow, 2)
                 sProduct = .cells(lRow, 4)
                 dPrice = .cells(lRow, 6)
             End With
             Write #iFNumber, dDate, sCustomer, sProduct, dPrice
             lRow = lRow + 1
         Loop Until IsEmpty(Sheet1.cells(lRow, 1))
         Close #iFNumber
     End Sub

uses the delimiter characters to decide the data type of each item and treat it appropriately:

 
     Sub ReadStringsWithDelimiters()
           Dim sLine As String
           Dim sFName As String     "Path and name of text file
           Dim iFNumber As Integer    "File number
           Dim lRow As Long     "Row number in worksheet
           Dim lColumn As Long      "Column number in worksheet
           Dim vValues As Variant
           Dim vValue As Variant
           Dim iCount As Integer
           Const sVS As String = ";"   "Variable separator character
           Const sTD As String = """"  "Text delimiter character
           Const sDD As String = "#"    "Date delimiter character
           sFName = "C:\Delimited.txt"
           iFNumber = FreeFile
           Open sFName For Input As #iFNumber
             Do
                   Line Input #iFNumber, sLine
                   vValues = Split(sLine, sVS)
                   For Each vValue In vValues
                   Select Case Left(vValue, 1)
                         "String
                      Case sTD
                         Debug.Print Mid(vValue, 2, Len(vValue) - 2)
                         "Date
                      Case sDD
                         Debug.Print DateValue(Mid(vValue, 2, Len(vValue) - 2))
                         "Other
                      Case Else
                         Debug.Print vValue
                   End Select
                   Next vValue
                   "Loop until end of file
             Loop Until EOF(iFNumber)
     Close #iFNumber

Writing to Text Files Using Print

 
     Sub WriteStrings()
         Dim sLine As String
         Dim sFName As String    "Path and name of text file
         Dim iFNumber As Integer    "File number
         Dim lRow As Long     "Row number in worksheet
         sFName = "C:\Strings.txt"
         iFNumber = FreeFile
         Open sFName For Output As #iFNumber
         lRow = 2
         Do
             With Sheet1
                 sLine = Format(.Cells(lRow, 1), "yyyy-mmm-dd") & ";"
                 sLine = sLine & .Cells(lRow, 2) & ";"
                 sLine = sLine & .Cells(lRow, 4) & ";"
                 sLine = sLine & Format(.Cells(lRow, 6), "0.00")
             End With
             Print #iFNumber, sLine
             lRow = lRow + 1
         Loop Until IsEmpty(Sheet1.Cells(lRow, 1))
         Close #iFNumber
     End Sub