VBA/Excel/Access/Word/File Path/Text File

Материал из VB Эксперт
Перейти к: навигация, поиск

Create and Save Text file

 
Private Sub Update()
    Dim myFileSystemObject As FileSystemObject
    Dim myFile As Object
    On Error Resume Next
    
    Set myFileSystemObject = New FileSystemObject
    Set myFile = myFileSystemObject.GetFile("C:\MyCust.txt")
    
    If Err.Number = 0 Then
        Set myFile = myFileSystemObject.OpenTextFile("C:\MyCust.txt", 8)
    Else
        Set myFile = myFileSystemObject.CreateTextFile("C:\MyCust.txt")
    End If
    myFile.WriteLine "File Created on: " & Date & " " & Time
    
    myFile.Close
    Set myFileSystemObject = Nothing
End Sub



Filtering a text file

 
Sub FilterFile()
    Open "infile.txt" For Input As #1
    Open "output.txt" For Output As #2
    TextToFind = "yourText"
    Do While Not EOF(1)
        Line Input #1, data
        If InStr(1, data, TextToFind) Then
            Print #2, data
        End If
    Loop
    Close
End Sub



Read a text file, adding the amounts

 
Sub wend()
    Open "C:\Invoice.txt" For Input As #1
    TotalSales = 0
    While Not EOF(1)
        Line Input #1, Data
        TotalSales = TotalSales + Data
    Wend
    MsgBox "Total Sales=" & TotalSales
    Close #1
End Sub



Read a text file, skipping the Total lines

 
Sub textDemo()
    Open "C:\Invoice.txt" For Input As #1
    Do Until EOF(1)
        Line Input #1, Data
        If Not (Data, 5) = "TOTAL" Then
            Debug.Print Data
        End If
    Loop
    Close #1
End Sub



Reading Text Files One Row at a Time

 
Sub Import10()
    ThisFile = "C\sales.txt"
    Open ThisFile For Input As #1
    For i = 1 To 10
        Line Input #1, Data
        Cells(i, 1).Value = Data
    Next i
    Close #1
End Sub



Save Date and Time information to a text file

 
Private Sub m_frm_AfterUpdate()
    Dim myFileSystemObject As FileSystemObject
    Dim myFile As Object
    Dim strFileN As String
    On Error Resume Next
    Set myFileSystemObject = New FileSystemObject
    strFileN = "C:\MyCust.txt"
    Set myFile = myFileSystemObject.GetFile(strFileN)
    If Err.Number = 0 Then
        " open text file
        Set myFile = myFileSystemObject.OpenTextFile(strFileN, 8)
    Else
        " create a text file
        Set myFile = myFileSystemObject.CreateTextFile(strFileN)
    End If
    myFile.WriteLine "File Created on: " & Date & " " & Time
    myFile.Close
    Set myFileSystemObject = Nothing
End Sub



Use a Do...While loop to keep reading records until you"ve reached the end of the file:

 
Sub ImportAll()
    ThisFile = "C:\sales.txt"
    Open ThisFile For Input As #1
    Ctr = 0
    Do
        Line Input #1, Data
        Ctr = Ctr + 1
        Cells(Ctr, 1).Value = Data
    Loop While EOF(1) = False
    Close #1
End Sub



Writing Text Files

 
Sub WriteFile()
    ThisFile = "C:\Results.txt"
    On Error Resume Next
    Kill (ThisFile)
    On Error GoTo 0
    Open ThisFile For Output As #1
    FinalRow = Range("A65536").End(xlUp).Row
    For j = 1 To FinalRow
        Print #1, Cells(j, 1).Value
    Next j
End Sub