vb 本地文件常用操作

‘//

’遍历文件夹

‘

'遍历文件夹
Private Sub ShowFolderList(folderspec)
     Dim fs, f, f1, s, sf
     Dim hs, h, h1, hf
     Set fs = CreateObject("Scripting.FileSystemObject")
     Set f = fs.GetFolder(folderspec)
     Set sf = f.SubFolders
     For Each f1 In sf
            List1.AddItem folderspec & "\" & f1.Name
           'Call ShowFolderList(folderspec & "\" & f1.Name)'去掉注释则为遍历主文件夹内所有文件夹，否只遍历一个文件夹下的文件夹
     Next
End Sub

//

遍历某文件夹下的文件

'遍历某文件夹下的文件
Private Sub Showfilelist(folderspec)
     Dim fs, f, f1, fc, s
     Set fs = CreateObject("Scripting.FileSystemObject")
     Set f = fs.GetFolder(folderspec)
     Set fc = f.Files
     For Each f1 In fc
     List1.AddItem f1.Name
     Next
End Sub

//

'遍历某文件夹及子文件夹中的所有文件

'遍历某文件夹及子文件夹中的所有文件
Sub sosuofile(MyPath As String)
    Dim Myname As String
    Dim a As String
    Dim B() As String
    Dim dir_i() As String
    Dim i, idir As Long
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath + "\"
    Myname = Dir(MyPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
    Do While Myname <> ""
        If Myname <> "." And Myname <> ".." Then
            If (GetAttr(MyPath & Myname) And vbDirectory) = vbDirectory Then '如果找到的是目录
                idir = idir + 1
                ReDim Preserve dir_i(idir) As String
                dir_i(idir - 1) = Myname
                Else
                List1.AddItem MyPath & Myname   '把找到的文件显示到列表框中
            End If
        End If
        Myname = Dir '搜索下一项
    Loop
    
    For i = 0 To idir - 1
        Call sosuofile(MyPath + dir_i(i))
    Next i
    
    ReDim dir_i(0) As String
End Sub

//

判断本地文件夹或文件是否存在

'判断文件是否存在
Public Function isFileExis(localPath As String) As Boolean
    
    If Dir(localPath, vbDirectory) = "" Then
    '不存在
    isFileExis = False
    Else
    '存在
    isFileExis = True
    End If

End Function

//

打开本地文件夹

Shell "explorer.exe " & "D:\TAE_SDK\htdocs", vbNormalFocus

//

默认浏览器找开网址

'默认浏览器打开'默认浏览器打开
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Sub openDefautBrowser(strURL As String)
    Dim r As Long
    r = ShellExecute(0, vbNullString, strURL, vbNullString, vbNullString, vbNormalFocus)
End Sub

//

调用本地软件打开路径

'//调用本地软件打开路径
Public Function openFileByLocalSoftwear(localSoftwearPath As String, openURL As String)
On Error GoTo er
        Shell "" & localSoftwearPath & " " & openURL, vbNormalFocus
        Exit Function
er:
        MsgBox Err.Description & vbCrLf & "请检查路径：" & localSoftwearPath & "" & vbCrLf & "请检查URL：" & openURL & "", , "提示"
End Function

//

创建一个文件夹

mkdir "文件夹名"

//

复制一个文件夹（含子文件夹及其所有文件）