vb基础知识和文件操作

一：基本知识
1，变量首字母大写，常量全部大写
2，switch（<表达式1>,条件为1时的值，【……】）
3，动态数组，Dim 数组名() As Integer ReDim [Preserve] 数组名(*to*,*to*) As Integer,Preserve关键字可以保证数组大小改变时，值还存在
4,使用ubound保证不会越界
5，Dim A As Variant（Dim A()） A = Array(10,20,30)

二：文件操作
1，open 文件名 For [output,input,append] As #文件号
2，output或append方式时，使用print #文件号,[输出列表]
3，output或append方式时，使用write #文件号,[输出列表]------这种方式，输出列表间自动用逗号隔开，字符串自动加双引号
4，output或append方式时，输出列表后面要加上分号，否则自动换行
5，output或append方式可以自动实现文件不存在则创建，很方便
6，使用output方式时，文件已经被清空，即使不写内容，当关闭文件的时候也是清空的
7，使用input方式时，Do While Not EOF(1) Line input #文件号,变量名 Loop
8，curdir(),dir(目录或者文件名，当目录时，使用第二参数vbDirectory<>""，vbcrlf，MKDIR
9，name path_name1 as path_name2 移动文件

10，返回当前工作薄的路径ThisWorkbook.Path

三：文件搜索

方法一，该方法可以用于excel2003，excel2007不可用

Dim photo_array(1 To 1000) As String With Application.FileSearch .NewSearch .LookIn = "c:/tupian" .SearchSubFolders = True .Filename = "*.jpg" If .Execute() > 0 Then For p = 1 To .FoundFiles.Count On Error Resume Next photo_array(p) = .FoundFiles(p) '获取图片路径，存放在数组中 Next p End If End With

方法二，该方法可以用于excel2003和excel2007

Public strArr() As String, rCount As Integer '文件检索 Function App_SearchSubFolder(keyword As String, rSearchSubFolders As Boolean) Dim fd As Object Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") '開啟Excel內建的資料夾瀏覽方塊 Set fd = Application.FileDialog(msoFileDialogFolderPicker) If fd.Show = -1 Then rLookIn = fd.SelectedItems(1) Else MsgBox "未選取資料夾": Exit Function End If rFilename = Dir$(rLookIn & "/" & keyword) rCount = 0 '建立動態陣列 ReDim Preserve strArr(rCount) '第一階資料夾 Do While rFilename <> vbNullString strArr(rCount) = rLookIn & "/" & rFilename rCount = rCount + 1 ReDim Preserve strArr(rCount) rFilename = Dir$() Loop If rSearchSubFolders Then '判斷是否搜尋子資料夾 '搜尋第二階以後的子資料夾 Call App_NextSubFolder(fso.GetFolder(rLookIn), keyword) End If Set fd = Nothing Set fso = Nothing End Function Private Sub App_NextSubFolder(ByRef Folder As Object, ByRef keyword As String) Dim SubFolder As Object For Each SubFolder In Folder.SubFolders rFilename = Dir$(SubFolder.Path & "/" & keyword) Do While rFilename <> vbNullString strArr(rCount) = SubFolder.Path & "/" & rFilename rCount = rCount + 1 ReDim Preserve strArr(rCount) rFilename = Dir$() Loop Call App_NextSubFolder(SubFolder, keyword) Next End Sub

四：读写指定编码文件

Public Function SaveFile(FileName As Variant, strFileBody As Variant) As Boolean
    Dim ADO_Stream As Object
    Set ADO_Stream = CreateObject("ADODB.Stream")
   
    With ADO_Stream
        .Type = 2
        .Mode = 3
        .Charset = "utf-8"
        .Open
        .WriteText strFileBody
        .SaveToFile FileName, 2
    End With
    
    SaveFile = True
    Set ADO_Stream = Nothing
End Function
 
 Public Function ReadUTF8(ByVal sUTF8File As String) As String
     If Len(sUTF8File) = 0 Or Dir(sUTF8File) = vbNullString Then Exit Function
     Dim ados As Object
     Set ados = CreateObject("adodb.stream")
     With ados
         .Charset = "utf-8"
         .Type = 2
         .Open
         .LoadFromFile sUTF8File
         ReadUTF8 = .ReadText
         .Close
     End With
     Set ados = Nothing
End Function

五：vba中工作表相关

没有表则创建

    SheetName = "新工作表"
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(SheetName)
    If Err = 0 Then
        SheetExists = True
    Else
        SheetExists = False
    End If
    
    If Not SheetExists Then
        Sheets.Add
        ActiveSheet.Name = SheetName
    End If