VBA比较常用共通方法(一)写文本文件续

来源:互联网 发布:软件停服通知 编辑:程序博客网 时间:2024/05/01 02:46
Public Function NewDir(ByVal strPath) As Boolean
    
    Dim dirAttr As VbFileAttribute
    
    dirAttr = vbNormal + vbDirectory + vbReadOnly
    If Dir(strPath, dirAttr) <> "" Then
        NewDir = True
        Exit Function
    End If
    
    Dim Pos As Long
    Dim strTemp As String
    
    On Error Resume Next
    Pos = InStr(1, strPath, "\")
    While Pos > 0
        strTemp = Left(strPath, Pos - 1)
        If Dir(strTemp, dirAttr) = "" Then MkDir strTemp
        Pos = InStr(Pos + 1, strPath, "\")
    Wend
    
    MkDir strPath
    
    NewDir = (Dir(strPath, dirAttr) <> "")
    If Err <> 0 Then Err.Clear
    
End Function

Public Sub SysErr(ByVal s As String)
    If IsAutoRun Then Exit Sub
    LimitMsgBoxText s
    MsgBox s, vbCritical, "错误提示"
End Sub

Private Sub LimitMsgBoxText(s As String)
    Const nMaxLen As Integer = 250
    If Len(s) > nMaxLen Then s = Left(s, nMaxLen) & "..."
End Sub

Public Sub KillFile(strFile As String)
    
    If Dir(strFile, vbHidden + vbNormal + vbReadOnly) <> "" Then
        SetAttr strFile, vbNormal
        Kill strFile
    End If
    
End Sub