- 帖子
- 109
- 主題
- 2
- 精華
- 0
- 積分
- 114
- 點名
- 0
- 作業系統
- Win7 Win10
- 軟體版本
- Office 2019 WPS
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 深圳
- 註冊時間
- 2013-2-2
- 最後登錄
- 2024-11-6
|
- Sub Test001()
- Dim FileName As String
- Dim hFile As Long
- Dim lngEndRow As Long
- Dim R As Long, C As Long
- Dim bytText() As Byte
- Dim strText As String
- Dim strCrLf As String
-
- R = InStrRev(ThisWorkbook.Name, ".")
- If R > 0 Then
- FileName = Left$(ThisWorkbook.Name, R - 1)
- Else
- FileName = ThisWorkbook.Name
- End If
- strCrLf = Space(21) & vbCrLf
- With Sheet1
- lngEndRow = .Range("A" & .Rows.Count).End(xlUp).Row
- hFile = FreeFile
- Open ThisWorkbook.Path & Application.PathSeparator & FileName & ".TXT" For Binary As hFile
- For R = 1 To lngEndRow
- strText = vbNullString
- For C = 1 To .UsedRange.Columns.Count
- strText = strText & .Cells(R, C).Text
- Next C
- strText = strText & IIf(Len(strText), strCrLf, vbCrLf)
- bytText() = StrConv(strText, vbFromUnicode)
- Put hFile, , bytText()
- Next R
- Close hFile
- End With
- End Sub
複製代碼 |
|