将Excel单元格导出为单个文本文件

Posted 2021-02-26

This is modified from code found here: http://www.meadinkent.co.uk/XLexport-text1.htm and here: http://www.meadinkent.co.uk/XLexport-text2.htm

Sub ExportToTextFiles()
Dim FirstRow As Integer, LastRow As Integer, MyFileName As String, MyRow As Integer, MyStr As String
 
' change these values to the start row and end row for your notes.
' if you have to use a range you'll need a double loop below
FirstRow = 1
LastRow = 4
 
For MyRow = FirstRow To LastRow
    MyFileName = "C:\formtest" & Str(MyRow) & ".txt"
 
    If DoesFileExist(MyFileName) = 0 Then
     Open MyFileName For Output As #1 ' create a new file and record if file does not exist
    Else
     Open MyFileName For Append As #1 ' append a record if file does already exist
    End If
 
     ' loop through each row of the table
     MyStr = Cells(MyRow, 1).Value
    Print #1, MyStr
    Close #1
Next
 
MsgBox "Done"
End Sub
 
Function DoesFileExist(FileName As String) As Byte
' returns 1 if FileName exists, otherwise 0
If Dir(FileName, vbNormal) <> "" Then
 DoesFileExist = 1
Else
 DoesFileExist = 0
End If
End Function