创建写入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