创建写入TXT_20191201001734.png
自定义创建并写入TXT，需要处理文件夹和文件名的是否存在及正确的问题！
'-----------------------------------------------
'创建并写入TXT文件
'-----------------------------------------------
Function openTXT(ByVal Content As String, Optional ByVal FileName As String = "", Optional ByVal FilePath As String = "") As Boolean
Dim FullName As String '完整文件名
'处理文件夹
If FilePath = "" Then
FilePath = ThisWorkbook.path '为空时默认当期文件夹
Else
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\" '填补右侧斜杠
If PathExists(FilePath) = False Then
FilePath = ThisWorkbook.path
MsgBox "您输入的文件夹地址有误，新地址为文件所在地址"
End If
End If
'处理文件名
If FileName = "" Then
FileName = "YEYU_" & Format(Now(), "yyyymmddhhmmss")
End If
'拼接完整地址
FullName = FilePath & "\" & FileName & ".txt"
'创建并写入文件
Open FullName For Output As #1
Print #1, Content
Close #1
'输出结果（判断是否创建成功）
openTXT = FileExists(FullName)
End Function
'+------------------------------------------------------------
'| 判断路径Path是否存在
'+------------------------------------------------------------
Public Function PathExists(pname) As Boolean
Dim x As String
On Error Resume Next
x = GetAttr(pname) And 0
If Err = 0 Then PathExists = True _
Else PathExists = False
End Function
'+------------------------------------------------------------
'| 判断文件File是否存在
'+------------------------------------------------------------
Private Function FileExists(fname) As Boolean
Dim x As String
x = Dir(fname)
If x <> "" Then FileExists = True _
Else FileExists = False
End Function
