常用代码归集

jsgj2023

Sub 新建文件夹_()
Dim sfolder  As String
sfolder = Application.InputBox(prompt:="请输入新建文件夹的名称:", _
Title:="输入文件夹名称", Type:=2)
If sfolder = "False" Or sfolder = "" Then Exit Sub
If Len(Dir(sfolder, vbDirectory)) > 0 Then
    MsgBox "文件夹" & sfolder & "已存在!"
Else
    MkDir sfolder
    MsgBox "文件夹" & sfolder & "创建成功!"
End If
End Sub

jsgj2023

Sub 复制文件_()
Dim sourcefile As String
Dim destinationfile As String
On Error GoTo err1
sourcefile = Application.InputBox(prompt:="请输入当前文件夹中源文件的名称:", _
Title:="源文件", Type:=2)
destinationfile = Application.InputBox(prompt:="请输入目标文件的名称", _
Title:="目标文件", Type:=2)
sourcefile = CurDir & "\" & sourctfile
If Len(Dir(sourcefile, vbDirectory)) > 0 Then
    FileCopy sourctfile, destinationfile
    MsgBox "复制成功!"
Else
    MsgBox "源文件" & sourcefile & "不存在!"
End If
err1:
If Err.Number <> 0 Then
    MsgBox "无法复制该文件!"
End If
End Sub

jsgj2023

Sub 重命名文件或者文件夹()
Dim sourctfile As String
Dim destinationfile As String
Dim spath  As String
SourceFile = Application.InputBox(prompt:="请输入需要重命名文件或文件夹的名称:", _
Title:="源文件", Type:=2)
Destination = Application.InputBox(prompt:="请输入文件或文件夹的新名称:", _
Title:="目标文件", Type:=2)
spath = ThisWorkbook.Path & "\"
SourceFile = spath & sourctfile
Destination = spath & destinationfile
If Len(Dir(SourceFile, vbDirectory)) > 0 Then
    Name SourceFile As destinationfile
    MsgBox "重命名成功!"
Else
    MsgBox "文件或文件夹" & SourceFile & "不存在!"
End If
End Sub

jsgj2023

Sub 删除文件_()
Dim sfilename As String
sfilename = Application.InputBox(prompt:="请输入需要删除的文件名:", _
Title:="输入文件名", Type:=2)
sfilename = ThisWorkbook.Path & "\" & sfilename
On Error Resume Next
Kill sfilename
On Error GoTo 0
End Sub

jsgj2023

Sub 删除文件夹_()
Dim sfolder   As String
sfolder = Application.InputBox(prompt:="请输入需要删除的文件夹名称:", _
Title:="输入文件夹", Type:=2)
sfolder = ThisWorkbook.Path & "\" & sfolder
If Len(Dir(sfolder & "\")) > 0 Then
    MsgBox "文件夹" & sfolder & "中有文件,不能删除该文件夹!"
Else
    RmDir sfolder
    MsgBox "文件夹" & sfolder & "已经删除!"
End If
End Sub

jsgj2023

Sub 判断文件是否存在()
Dim fso  As New Scripting.FileSystemObject
Dim sfilename   As String
sfilename = Application.InputBox(prompt:="请输入文件名称", _
Default:=ThisWorkbook.FullName, Title:="输入文件名称", Type:=2)
If sfilename = "False" Then Exit Sub
If fso.FileExists(sfilename) Then
    MsgBox "文件" & sfilename & "存在!"
Else
    MsgBox "文件" & sfilename & "不存在!"
End If
Set fso = Nothing
End Sub

jsgj2023

Sub 判断文件夹是否存在()
Dim fso As New Scripting.FileSystemObject
Dim sfolder As String
sfolder = Application.InputBox(prompt:="请输入文件夹名称", _
Default:=ThisWorkbook.Path, Title:="输入文件夹名称", Type:=2)
If sfolder = "False" Then Exit Sub
If fso.FolderExists(sfolder) = True Then
    MsgBox "文件夹" & sfolder & "存在!"
Else
    MsgBox "文件夹" & sfolder & "不存在!"
End If
Set fso = Nothing
End Sub

jsgj2023

Sub 分离文件名和扩展名_()
Dim fso As New Scripting.FileSystemObject
Dim sfilename As String
Dim str1 As String
sfilename = ThisWorkbook.FullName
str1 = "本工作簿文件的全名:" & fso.GetFileName(sfilename)
str1 = str1 & vbCrLf & vbCrLf
str1 = str1 & "基础名:" & fso.GetBaseName(sfilename)
str1 = str1 & vbCrLf & vbCrLf
str1 = srt1 & "扩展名:" & fso.GetExtensionName(sfilename)
MsgBox str1, vbInformation + vbOKOnly, "提示"
Set fso = Nothing
End Sub

jsgj2023

Sub 查看文件属性()
    Dim sfilename As String
    Dim stype As String
    Dim itype As Integer
    sfilename = Application.InputBox(prompt:="请输入文件名", _
    Title:="输入文件名", Default:=ThisWorkbook.FullName, Type:=2)
    If sfilename = "False" Then Exit Sub
    With ActiveSheet
        .Range(Cells(4, 1), Cells(7, 2)).Clear
        .Cells(4, 1) = sfilename
        .Cells(4, 1).Font.Bold = True
        .Cells(5, 1) = "文件大小:"
        .Cells(5, 2) = FileLen(sfilename) & "byte"
        .Cells(6, 1) = "文件类型:"
        itype = GetAttr(sfilename)
        If itype And vbNormal = 0 Then
            stype = "常规文件"
        ElseIf itype And vnreadonly Then
            stype = "只读文件"
        ElseIf itype And vbHidden Then
            stype = "隐藏文件"
        ElseIf itype And vbSystem Then
            stype = "系统文件"
        ElseIf itype And vbArchive Then
            stype = "备份文件"
        ElseIf itype And vbDirectory Then
            stype = "文件夹"
        End If
        .Cells(6, 2) = stype
        .Cells(7, 1) = "最后修改时间:"
        .Cells(7, 2) = FileDateTime(sfilename)
    End With
End Sub

chinaling008

看看有没有帮助，谢谢