(2017-03-18 银河统计)
Excel_VBA类模块框架是在Excel后台通过vba编程方式,实现类似R语言模块化数据操作的功能,对数据进行处理、挖掘、建模及可视化,提高数据分析和挖掘人员的数据处理效率,从而能将更多的时间投入到数据挖掘中,发现隐藏在数据中的价值。
目录
1.vbaExcel
2.vbaRWSD
3.vbaArray
4.vbaTxt
5.vbaTxtTrUTF8
7.vbaSql
8.vbaAccess
9.vbaToArrayTo
10.vbaPPt
待续……
- 11.vbaWord
待续……
- 12.vbaFileSystem
待续……
- 13.vbaModel
待续……
- 14.vbaJson
待续……
- 15.vbaChart
待续……
- 16.vbaString
待续……
- 17.vbaWeb
待续……
- 18.vbaStatistics
待续……
- 19.vbaMath
待续……
- 20.vbaCalculation
待续……
1.vbaExcel
'###################################################################
'函数作用: Excel数据写入成二维数组(特定数据起始位置)
'语法: oDataTransArr2(ByVal oSheet As String, ByVal oCellLocation As String)
'参数说明: oSheet 工作簿中工作表的名称
' oCellLocation 工作表中数据起始单元格位置, 其中oCellLocation限制在(a-z)(1-26)位置
'示例: oDataTransArr2("Excel", "A1")
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
arr1 = abdata.oDataTransArr2("Excel", "A1")
End Sub
'###################################################################
'###################################################################
'函数作用: Excel数据写入成二维数组(任意数据起始位置)
'语法: oDataTransArrRY2(ByVal oSheet As String, ByVal oCellLocation As String, ByVal oColumn As Long)
'参数说明: oSheet 工作簿中工作表的名称
' oCellLocation 工作表中数据起始单元格位置, 其中oCellLocation可以是"任意"位置
' oColumn 数据起始单元格所在的列数(如果该参数省略,说明程序自动判断了)
'示例: oDataTransArrRY2("Excel", "A1", 1)
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
arr1 = abdata.oDataTransArrRY2("Excel", "A1", 1)
End Sub
'###################################################################
'###################################################################
'函数作用: Excel"横向"数据写入成一维数组 (a-z)(1-26)位置(特定数据起始位置)
'语法: oDataTransArrH1(ByVal oSheet As String, ByVal oCellLocation As String)
'参数说明: oSheet 工作簿中工作表的名称
' oCellLocation 工作表中数据起始单元格位置, 其中oCellLocation限制在(a-z)(1-26)位置
'示例: oDataTransArrH1("Excel", "B8")
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
arr1 = abdata.oDataTransArrH1("Excel", "B8")
End Sub
'###################################################################
'###################################################################
'函数作用: Excel"横向"数据写入成一维数组("任意"位置)
'语法: oDataTransArrRYH1 (ByVal oSheet As String, ByVal oCellLocation As String , ByVal oColumn As Long)
'参数说明: oSheet 工作簿中工作表的名称
' oCellLocation 工作表中数据起始单元格位置, 其中oCellLocation可以是"任意"位置
' oColumn 数据起始单元格所在的列数(如果该参数省略,说明程序自动判断了)
'示例: oDataTransArrRYH1 ("Excel", "B8", 2)
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
arr1 = abdata.oDataTransArrRYH1 ("Excel", "Z8", 26)
End Sub
'###################################################################
'###################################################################
'函数作用: Excel"竖向数据"写入成一维数组 (a-z)(1-26) 位置
'语法: oDataTransArrS1 (ByVal oSheet As String, ByVal oCellLocation As String )
'参数说明: oSheet 工作簿中工作表的名称
' oCellLocation 工作表中数据起始单元格位置, 其中oCellLocation限制在(a-z)(1-26)位置
'示例: oDataTransArrS1 ("Excel", "B8")
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
arr1 = abdata.oDataTransArrS1 ("Excel", "Z8")
End Sub
'###################################################################
'###################################################################
'函数作用: Excel"竖向数据"写入成一维数组("任意"位置)
'语法: oDataTransArrRYS1 (ByVal oSheet As String, ByVal oCellLocation As String , ByVal oColumn As Long)
'参数说明: oSheet 工作簿中工作表的名称
' oCellLocation 工作表中数据起始单元格位置, 其中oCellLocation可以是"任意"位置
' oColumn 数据起始单元格所在的列数(如果该参数省略,说明程序自动判断了)
'示例: oDataTransArrRYS1 ("Excel", "B8", 2)
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
arr1 = abdata.oDataTransArrRYS1 ("Excel", "Z8", 26)
End Sub
'###################################################################
'###################################################################
'函数作用: 二维数组导出成Excel数据 (a-z)(1-26) 位置 (使用call调用)
'语法: oArrTransData2 (ByVal oDataArr, ByVal oSheet As String, ByVal oCellLocation As String)
'参数说明: oDataArr 希望转换成数据的数组(一维或二维)
' oSheet 工作簿中工作表的名称
' oCellLocation 将数组数据写入工作表中时,起始单元格位置, 其中oCellLocation限制在(a-z)(1-26)位置
'示例: oArrTransData2 (arr, "Excel", "A1")
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
Call abdata.oArrTransData2 (arr, "Excel", "A1")
End Sub
'###################################################################
'###################################################################
'函数作用: 二维数组导出成Excel数据 ("任意"位置) (使用call调用)
'语法: oArrTransDataRY2 (ByVal oDataArr, ByVal oSheet As String, ByVal oCellLocation As String, ByVal oColumn As Long)
'参数说明: oDataArr 希望转换成数据的数组(一维或二维)
' oSheet 工作簿中工作表的名称
' oCellLocation 将数组数据写入工作表中时,起始单元格位置, 其中oCellLocation可以是"任意"位置
' oColumn 数据起始单元格所在的列数(如果该参数省略,说明程序自动判断了)
'示例: oArrTransDataRY2 (arr, "ExcelHelp", "AA10", 27)
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
call abdata.oArrTransDataRY2 (arr, "ExcelHelp", "AA10", 27)
End Sub
'###################################################################
'###################################################################
'函数作用: 一维数组数据横向写入单元格(a-z)(1-26)位置 (使用call调用)
'语法: oArrTransDataH1 (ByVal oDataArr, ByVal oSheet As String, ByVal oCellLocation As String)
'参数说明: oDataArr 希望转换成数据的数组(一维或二维)
' oSheet 工作簿中工作表的名称
' oCellLocation 将数组数据写入工作表中时,起始单元格位置,其中oCellLocation限制在(a-z)(1-26)位置
'示例: oArrTransDataH1 (arr,"Excel", "B8")
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
call abdata.oArrTransDataH1 (arr,"Excel", "B8")
End Sub
'###################################################################
'###################################################################
'函数作用: 一维数组数据横向写入单元格("任意"位置) (使用call调用)
'语法: oArrTransDataRYH1 (ByVal oDataArr, ByVal oSheet As String, ByVal oCellLocation As String , ByVal oColumn As Long)
'参数说明: oDataArr 希望转换成数据的数组(一维或二维)
' oSheet 工作簿中工作表的名称
' oCellLocation 将数组数据写入工作表中时,起始单元格位置,其中oCellLocation可以是"任意"位置
' oColumn 数据起始单元格所在的列数(如果该参数省略,说明程序自动判断了)
'示例: oArrTransDataRYH1 (arr,"Excel", "B8", 2)
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
call abdata.oArrTransDataRYH1 (arr,"Excel", "Z8", 26)
End Sub
'###################################################################
'###################################################################
'函数作用: 一维数组数据竖向写入单元格(a-z)(1-26)位置 (使用call调用)
'语法: oArrTransDataS1 (ByVal oDataArr, ByVal oSheet As String, ByVal oCellLocation As String )
'参数说明: oDataArr 希望转换成数据的数组(一维或二维)
' oSheet 工作簿中工作表的名称
' oCellLocation 将数组数据写入工作表中时,起始单元格位置,其中oCellLocation限制在(a-z)(1-26)位置
'示例: oArrTransDataS1 (arr, "Excel", "B8")
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
call abdata.oArrTransDataS1 (arr,"Excel", "Z8")
End Sub
'###################################################################
'###################################################################
'函数作用: 一维数组数据竖向写入单元格("任意"位置) (使用call调用)
'语法: oArrTransDataRYS1 (ByVal oDataArr, ByVal oSheet As String, ByVal oCellLocation As String , ByVal oColumn As Long)
'参数说明: oDataArr 希望转换成数据的数组(一维或二维)
' oSheet 工作簿中工作表的名称
' oCellLocation 将数组数据写入工作表中时,起始单元格位置,其中oCellLocation可以是"任意"位置
' oColumn 数据起始单元格所在的列数(如果该参数省略,说明程序自动判断了)
'示例: oArrTransDataRYS1 (arr, "Excel", "B8", 2)
Sub Demo()
Dim abdata As New vbaExcel
Dim arr1
call abdata.oArrTransDataRYS1 (arr, "Excel", "Z8", 26)
End Sub
'###################################################################
'###################################################################
'函数作用: 从另外一个excel工作薄中读取数据到数组中
'语法: oReadFromOtherExcel (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oSheet As String, ByVal oCellLocation As String, ByVal oColumn As Long, ByVal oTypeColumn As Long)
'参数说明: parentFolderPath excel工作薄的路径
' DocumentName excel工作薄的名称
' oType excel工作薄的类型(.xlsx | .xls | .xlsm)
' oSheet excel工作表的名称 (例如:"Home1")
' oCellLocation excel工作表的"位置"|单元格名称 (例如:"A1")
' oColumn 单元格(A1)代表的列数 (例如:1)
' oTypeColumn 读取数据的方式 |(1:读取数据到二维数组 2:横向读取数据到一维数组 3:竖向读取数据到一维数组)
'示例: oReadFromOtherExcel("I:\", "Microsoft Excel", "xlsx", "Sheet3", "B2", 2, 3)
Sub Demo()
Dim abdata As New vbaExcel
Dim str1, str2, str3, str4, str5, str6
Dim arr
str1 = "I:\"
str2 = "Microsoft Excel"
str3 = "xlsx"
str4 = "Sheet3"
str5 = "B2"
str6 = "csv"
arr = abdata.oReadFromOtherExcel(str1, str2, str3, str4, str5, 2, 3)
End Sub
'###################################################################
'###################################################################
'函数作用: 将数据写入到(excel)工作薄中,保存工作薄为(另外)一种格式
'语法: oWriteIntoOtherExcel (ByVal oDataArr, ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oSheet As String, ByVal oCellLocation As String, ByVal oColumn As Long, ByVal oTypeColumn As Long)
'参数说明: oDataArr 导入到工作簿中 | <数组数据>
' parentFolderPath excel工作薄的路径
' DocumentName excel工作薄的名称
' oType excel工作薄的类型(.xlsx | .xls | .xlsm)
' oSheet excel工作表的名称 (例如:"Home1")
' oCellLocation excel工作表的"位置"|单元格名称 (例如:"A1")
' oColumn 单元格(A1)代表的列数 (例如:1)
' oTypeColumn 写入数据的方式|(1:二维数组数据写入到工作表 2:一维数组数据横向写入到工作表 3:一维数组数据竖向写入到工作表 )
'示例: oWriteIntoOtherExcel (arr, "I:\", "Microsoft Excel", "csv", "Sheet1", "B2", 2, 3)
Sub Demo()
Dim abdata As New vbaExcel
Dim str1, str2, str3, str4, str5, str6
Dim arr
str1 = "I:\"
str2 = "Microsoft Excel"
str3 = "xlsx"
str4 = "Sheet3"
str5 = "B2"
str6 = "csv"
call abdata.oWriteIntoOtherExcel (arr, str1, str2, str6, "Sheet1", str5, 2, 3)
End Sub
'###################################################################
'###################################################################
'函数作用: 将数据写入到(excel)工作薄中
'语法: oWriteIntoExcel (ByVal oDataArr, ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oSheet As String, ByVal oCellLocation As String, ByVal oColumn As Long, ByVal oTypeColumn As Long)
'参数说明: oDataArr 导入到工作簿中 | <数组数据>
' parentFolderPath excel工作薄的路径
' DocumentName excel工作薄的名称
' oType excel工作薄的类型(.xlsx | .xls | .xlsm)
' oSheet excel工作表的名称 (例如:"Home1")
' oCellLocation excel工作表的"位置"|单元格名称 (例如:"A1")
' oColumn 单元格(A1)代表的列数 (例如:1)
' oTypeColumn 写入数据的方式|(1:二维数组数据写入到工作表 2:一维数组数据横向写入到工作表 3:一维数组数据竖向写入到工作表 )
'示例: oWriteIntoExcel (arr, "I:\", "Microsoft Excel", "csv", "Sheet1", "B2", 2, 3)
Sub Demo()
Dim abdata As New vbaExcel
Dim str1, str2, str3, str4, str5, str6
Dim arr
str1 = "I:\"
str2 = "Microsoft Excel"
str3 = "xlsx"
str4 = "Sheet3"
str5 = "B2"
str6 = "csv"
call abdata.oWriteOtherExcel (arr, str1, str2, str6, "Sheet1", str5, 2, 3)
End Sub
'###################################################################
'###################################################################
'函数作用: 从最后到最前count 列数
'语法: oCountColumn1 (ByVal oSheet As String, ByVal oNumberRow As String)
'参数说明: oSheet excel工作表的名称
' oNumberRow 单元格位置的行号,数字表示(如:1、2)
'示例: oCountColumn1( “Sheet1”, 5)
Sub Demo()
Dim abdata As New vbaExcel
Dim oNum
Dim str1
Str1 = ” Sheet1”
oNum = abdata.oCountColumn1 ( str1, 2)
End Sub
'###################################################################
'###################################################################
'函数作用: 从最前到最后count 列数
'语法: oCountColumn2 (ByVal oSheet As String, ByVal oCellLocation As String)
'参数说明: oSheet excel工作表的名称
' oCellLocation 单元格的位置(如:A1、B2)
'示例: oCountColumn2 ( “Sheet1”, “A1”)
Sub Demo()
Dim abdata As New vbaExcel
Dim oNum
Dim str1
Str1 = ”Sheet1”
oNum = abdata.oCountColumn2 ( str1, “A1”)
End Sub
'###################################################################
'###################################################################
'函数作用: 从最后到最前count 行数
'语法: oCountRow1 (ByVal oSheet As String, ByVal oLetterColumn As String)
'参数说明: oSheet excel工作表的名称
' oLetterColumn 单元格位置的列号,字母表示(如:A、B)
'示例: oCountRow1 ( “Sheet1”, “A”)
Sub Demo()
Dim abdata As New vbaExcel
Dim oNum
Dim str1
Str1 = ”Sheet1”
oNum = abdata.oCountRow1 ( str1, “A”)
End Sub
'###################################################################
'###################################################################
'函数作用: 从最前到最后count 行数
'语法: oCountRow2 (ByVal oSheet As String, ByVal oCellLocation As String)
'参数说明: oSheet excel工作表的名称
' oCellLocation 单元格的位置(如:A1、B2)
'示例: oCountRow2 ( “Sheet1”, “A1”)
Sub Demo()
Dim abdata As New vbaExcel
Dim oNum
Dim str1
Str1 = ”Sheet1”
oNum = abdata.oCountRow2 ( str1, “A1”)
End Sub
'###################################################################
'###################################################################
'函数作用: 自动清除指定区域
'语法: oClearData (ByVal oSheet As String, ByVal oRange As String, ByVal oNum As Integer)
'参数说明: oSheet excel工作表的名称
' oRange 单元格的位置(如:A1、B2)
' oNum 单元格的位置(如:A1、B2)
' 1 Sheets(oSheet).Range(oRange) = ""d
' 2 Sheets(oSheet).Range(oRange).Clear
' 3 Sheets(oSheet).Range(oRange).ClearContents
' 4 Sheets(oSheet).Range(oRange).ClearFormats
'示例: oClearData ( “Sheet1”, ” E1:E5” , 1)
Sub Demo()
Dim abdata As New vbaExcel
Dim oNum
Dim str1, str2
Str1 = ”Sheet1”
Str1 = ” E1:E5”
call abdata.oClearData ( str1, str2, 1)
End Sub
'###################################################################
2.vbaRWSD
'###################################################################
'函数作用:文件夹的新建 | 在VBA中,可以通过MkDir和FileSystemObject的CreateFolder方法来创建文件夹
'语法: oCreateFolder (ByVal parentFolderPath As String, ByVal newFolderName As String)
'参数说明: parentFolderPath = "D:\" '父文件夹的名称(地址路径)
' newFolderName = "AA" '新建文件夹的名称
'示例: oCreateFolder ("I:\", "12345")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2, str3
str2 = "12345"
str3 = "I:\"
Call abdata.oCreateFolder (str3, str2)
End Sub
'###################################################################
'###################################################################
'函数作用:判断某个文件夹是否存在 | 使用FileSystemObject的FolderExists方法,来判断某个文件夹是否存在
'语法: oFolderExisits (ByVal parentFolderPath As String, ByVal FolderName As String)
'参数说明: parentFolderPath = "D:\CC\EE\" '父文件夹的名称(地址路径)
' FolderName = "A3" '要判断的文件夹名称
' oFolderExisits = 1 ' 1 所判断的文件夹 存在
' oFolderExisits = 0 ' 0 所判断的文件夹 不存在
'示例: oFolderExisits ("I:\", "12345")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str1, str2 As String
Dim str
str1 = "D:\CC\EE\"
str2 = "A3"
str = abdata.oFolderExisits(str1, str2)
MsgBox str
End Sub
'###################################################################
'###################################################################
'函数作用:文件夹里内容的复制(拷贝) | 在VBA中,可以通过FileSystemObject的CopyFolder方法来创建文件夹 | 复制folder中所有文件到newFolder
'语法: oCopyFolder (ByVal folder As String, ByVal newFolder As String)
'参数说明: folder = "D:\AA" '※1拷贝元
' newFolder = "D:\CC" '※2拷贝目的源
'示例: oCopyFolder ("I:\", "12345")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str1, str2 As String
str1 = "D:\AA" '※1拷贝元
str2 = "D:\CC\ff" '※2拷贝目的源
Call abdata.oCopyFolder(str1, str2)
End Sub
'###################################################################
'###################################################################
'函数作用:文件夹的删除(包括删除文件夹和文件夹里的内容) | 在VBA中,可以通过FileSystemObject的DeleteFolder方法来创建文件夹
'语法: oDeleteFolder (ByVal parentFolderPath As String, ByVal deleteFolderName As String)
'参数说明: parentFolderPath = "D:\" '父文件夹的名称(地址路径)
' deleteFolderName = "AA" '要删除的文件夹名称
'示例: oDeleteFolder ("I:\", "12345")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str1, str2 As String
str1 = "D:\CC\"
str2 = "BB"
Call abdata.oDeleteFolder(str1, str2)
End Sub
'###################################################################
'###################################################################
'函数作用:文件夹名称的读取
'语法: oReadFolderName (ByVal mypath As String)
'参数说明: mypath 参数:要提取的文件夹名称的路径
' arr 返回值:将读取的文件夹名称写入数组中
'示例: oReadFolderName ("I:\")
Sub Demo()
Dim abdata As New vbaRWSD
Dim abdata1 As New vbaExcel
Dim str1, str2 As String
Dim str, str3, str4
str1 = "D:\Office_Visio_Pro_2007\"
str2 = "2014.4.2桌面" ' & "\" & "VBA80集示例文件"
str4 = "C:\Users\abdata\Desktop" & "\" & str2 & "\"
str = abdata.oReadFolderName(str1)
str3 = abdata.oReadFolderName(str4)
Call abdata1.oArrTransDataS1(str, "RWSD", "E1")
Call abdata1.oArrTransDataS1(str3, "RWSD", "G1")
End Sub
'###################################################################
'###################################################################
'函数作用:文件名称的读取
'语法: oReadDocumentName (ByVal mypath As String, ByVal oDocumentSuffix As String)
'参数说明: mypath 参数:要提取的文件夹名称的路径
' oDocumentSuffix 参数:文件的后缀名称
' arr 返回值:将读取的文件夹名称写入数组中
'示例: oReadDocumentName ("I:\", "txt")
Sub Demo()
Dim abdata As New vbaRWSD
Dim abdata1 As New vbaExcel
Dim str, str3, str4
str4 = "C:\Users\abdata\Desktop" & "\" & "2014.4.2桌面" & "\"
str3 = "txt"
str = abdata.oReadDocumentName(str4, str3)
Call abdata1.oArrTransDataS1(str, "RWSD", "I1")
End Sub
'###################################################################
'###################################################################
'函数作用:文件夹名称的读取
'语法: oDeleteDocument (ByVal mypath As String, ByVal oDocumentName As String)
'参数说明: mypath 参数:要提取的文件夹名称的路径
' oDocumentName 参数:要删除的文件名称
'示例: oDeleteDocument ("I:\", "新建文本文档.txt")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str3, str4
str4 = "C:\Users\abdata\Desktop" & "\" & "2014.4.2桌面" & "\"
str3 = "新建文本文档.txt"
Call abdata.oDeleteDocument(str4, str3)
End Sub
'###################################################################
'###################################################################
'函数作用:判断某个文件是否存在 | 使用FileSystemObject的FileExists方法,来判断某个文件夹是否存在
'语法: oDocumentExisits (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath = "D:\CC\EE\" '父文件夹的名称(地址路径)
' DocumentName = "A3" '要判断的文件名称
' oType '文件后缀名称
' oDocumentExisits = 1 ' 1 所判断的文件夹 存在
' oDocumentExisits = 0 ' 0 所判断的文件夹 不存在
'示例: oDocumentExisits ("I:\", "12345",”txt”)
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2, str3, str4, str
str4 = "C:\Users\abdata\Desktop" & "\" & "2014.4.2桌面" & "\"
str3 = "新建文本文档"
str2 = " txt"
str = abdata.oDocumentExisits(str4, str3, str2)
MsgBox str
End Sub
'###################################################################
'###################################################################
'函数作用:文件的“位置移动”及“重命名” | 将“文件1”复制到新文件夹重新命名为“文件2” | “文件1名”可以等于“文件2名”
'语法: oCopyMoveDocument (ByVal parentFolderPath1 As String, ByVal DocumentName1 As String, ByVal parentFolderPath2 As String, ByVal DocumentName2 As String)
'参数说明: parentFolderPath1 '文件本来的位置(地址路径)
' DocumentName1 '文件名称
' parentFolderPath2 '文件移动的去向(地址路径)
' DocumentName2 '重命名的文件名称
'示例: oCopyMoveDocument ("I:\", "12345","I:\",”txt”)
Sub Demo()
Dim abdata As New vbaRWSD
Dim str1, str2, str3, str4
str1 = "C:\Users\abdata\Desktop" & "\" & "2014.4.2桌面" & "\"
str2 = "新建文本文档.txt"
str3 = "C:\Users\abdata\Desktop" & "\" & "2014.4.2桌面 - 副本" & "\"
str4 = "文本文档.txt"
Call abdata.oCopyMoveDocument(str1, str2, str3, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 文件的“重命名” | 重命名“文件1”为“文件2”
'语法: oReNameDocument (ByVal parentFolderPath As String, ByVal DocumentName1 As String, ByVal DocumentName2 As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName1 '文件名称
' DocumentName2 '重命名的文件名称
'示例: oReNameDocument ("I:\", "12345",”txt”)
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2, str3, str4
str2 = "文本文档.txt"
str3 = "C:\Users\abdata\Desktop" & "\" & "2014.4.2桌面 - 副本" & "\"
str4 = "文本.txt"
Call abdata.oReNameDocument(str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 新建Excel文件(.xls .xlsx .csv)
'语法: oCreatExcel (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType '新建的Excel文件的类型
'示例: oCreatExcel ("I:\", "12345",”xlsx”)
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2, str3, str4 As String
str2 = "brcsv"
str3 = "I:\"
str4 = "csv"
Call abdata.oCreatExcel(str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 将Excel的某个工作表保存为PDF
'语法: oExcelSaveAsPDF (ByVal oSheet As String, ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: oSheet 要保存的工作表名称
' parentFolderPath 保存的路径
' DocumentName 保存的pdf的名称
' oType PDF的后缀名称(.pdf)
'示例: oExcelSaveAsPDF ("brcsv ","I:\", "12345",”xlsx”)
Sub Demo()
Dim abdata As New vbaRWSD
Dim str1, str2, str3, str4 As String
str1 = "Access"
str2 = "brcsv"
str3 = "I:\"
str4 = "csv"
Call abdata.oExcelSaveAsPDF(str1, str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 新建Access文件
'语法: oCreatAccess (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType '新建的Access文件的类型(mdb accdb)
'示例: oCreatAccess ("I:\", "12345",”mdb”)
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2, str3, str4 As String
str2 = "12345"
str3 = "C:\Users\abdata\Desktop\2\"
str4 = "mdb"
Call abdata.oCreatAccess(str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 打开文件夹中所有文件(不管是excel,还是txt|access打开之后表现形式都是以excel表现形式打开的)
'语法: oOpenAllDocument (ByVal parentFolderPath As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
'示例: oCreatAccess ("I:\")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2 As String
str2 = "C:\Users\abdata\Desktop\3"
Call abdata.oOpenAllDocument(str2)
End Sub
'###################################################################
'###################################################################
'函数作用: 设定个人信息资料能否删除
'语法: oPersonalInformation (ByVal oNum)
'参数说明: oNum 常数 1 表示 True 删除 | 0 表示 False 不删除
'示例: oCreatAccess (1)
Sub Demo()
Dim abdata As New vbaRWSD
Call abdata.oPersonalInformation (0)
End Sub
'###################################################################
'###################################################################
'函数作用: 判断某个光驱有无及取得盘符 | 通过FileSystemObject的DriveExists来判断某个盘符是否是光驱盘,通过Drive方法来取得盘符。
'语法: oIsDrive (ByVal drive As String)
'参数说明: drive = "h" '修改这里,填入想要查询的盘符
' 1 表示"有" 0 表示"无"
'示例: oIsDrive ("I")
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2 As String
Dim str
str2 = "C"
str = abdata.oIsDrive (str2)
End Sub
'###################################################################
'###################################################################
'函数作用: 取得当前执行VBA宏的Excel所在的盘符
'语法: oGetDriveName ()
'参数说明: drive = "h" '修改这里,填入想要查询的盘符
' 1 表示"有" 0 表示"无"
'示例: oGetDriveName ()
Sub Demo()
Dim abdata As New vbaRWSD
Dim str2 As String
str2 = abdata.oGetDriveName ()
End Sub
'###################################################################
3.vbaArray
'###################################################################
'函数作用: 一维数组 下限" 0 "开始 转换成 下限" 1 "开始
'语法: oLBoundTransOne1 (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oLBoundTransOne1 (oArr1)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oLBoundTransOne1(arr1)
End Sub
'###################################################################
'###################################################################
'函数作用: 二维数组 下限" 0 "开始 转换成 下限" 1 "开始
'语法: oLBoundTransOne2 (ByVal oArr)
'参数说明: oArr 需要进行转换的二维数组
'示例: oLBoundTransOne2 (oArr1)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oLBoundTransOne2 (arr1)
End Sub
'###################################################################
'###################################################################
'函数作用: 把一维数组加入到二数组中,按照"行"的方式加入一维数组
'语法: oArr1AddRArr2 (ByVal oArr2, ByVal oArr1, ByVal oRow As Long)
'参数说明: oArr2 需要被加入数据的二维数组
' oArr1 加入二维数组的一维数组数据
' oRow 将一维数组加入到二维数组的"某行"数据之前
'示例: oArr1AddRArr2 (oArr2, oArr1,3)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArr1AddRArr2 (arr1, arr2, 3)
End Sub
'###################################################################
'###################################################################
'函数作用: 把一维数组加入到二数组中,按照"列"的方式加入一维数组
'语法: oArr1AddCArr2 (ByVal oArr2, ByVal oArr1, ByVal oColumn As Long)
'参数说明: oArr2 需要被加入数据的二维数组
' oArr1 加入二维数组的一维数组数据
' oColumn 将一维数组加入到二维数组的"某列"数据之前
'示例: oArr1AddCArr2 (oArr2, oArr1,3)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArr1AddCArr2 (arr1, arr2, 3)
End Sub
'###################################################################
'###################################################################
'函数作用:提取二数组的某一维数据转换成一维数组,提取某行转成一维数组
'语法: oExtractRowTransArr (ByVal oArr, ByVal oRow As Long)
'参数说明: oArr 需要提取数据的二维数组
' oRow 二维数组的某行数据转成一维数组
'示例: oExtractRowTransArr (oArr, 3)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oExtractRowTransArr (arr1, 3)
End Sub
'###################################################################
'###################################################################
'函数作用:提取二数组的某一维数据转换成一维数组,提取某列转成一维数组
'语法: oExtractColumnTransArr (ByVal oArr, ByVal oColumn As Long)
'参数说明: oArr 需要提取数据的二维数组
' oColumn 二维数组的某列数据转成一维数组
'示例: oExtractColumnTransArr (oArr, 3)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oExtractColumnTransArr (arr1, 3)
End Sub
'###################################################################
'###################################################################
'函数作用: 以行的形式将一维数组组合成二维数组
'语法: oRowBind (Optional ByVal oNumber As Long, Optional ByVal arr1,……)
'参数说明: oNumber 需要进行合并的一维数组数量
' arr1 一维数组 1
' arr2 一维数组 2
'示例: oRowBind (3, arr1, arr2, arr3)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oRowBind (3, arr1, arr2, arr3)
End Sub
'###################################################################
'###################################################################
'函数作用: 以列的形式将一维数组组合成二维数组
'语法: oColumnBind (Optional ByVal oNumber As Long, Optional ByVal arr1,……)
'参数说明: oNumber 需要进行合并的一维数组数量
' arr1 一维数组 1
' arr2 一维数组 2
'示例: oColumnBind (3, arr1, arr2, arr3)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oColumnBind (3, arr1, arr2, arr3)
End Sub
'###################################################################
'###################################################################
'函数作用:根据字符串"不同的分隔符"将字符串拆分成数组,字符串拆成一维数组
'语法: oStrTransArr1 (ByVal oStr As String, ByVal str As String)
'参数说明: oStr 需要拆分的字符串
' str 分隔符号
'示例: oStrTransArr1 ( oStr , ”#” )
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oStrTransArr1 (oStr , ”#”)
End Sub
'###################################################################
'###################################################################
'函数作用:根据字符串"不同的分隔符"将字符串拆分成数组,字符串拆成二维数组
'语法: oStrTransArr2 (ByVal oStr As String, ByVal str1 As String, ByVal str2 As String)
'参数说明: oStr 需要拆分的字符串
' str1 行分隔符号
' str2 列分隔符号
'示例: oStrTransArr2 ( oStr , ”#” , ”$”)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oStrTransArr2 (oStr , ”#” , ”$”)
End Sub
'###################################################################
'###################################################################
'函数作用:一维数组转换成为VBA后台 数组初始化 形式 (原始形式|数字形式)
'语法: oArrTransArrayNum1 (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrayNum1 (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrayNum1 (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用:二维数组转换成为VBA后台(数组初始化 Array 形式)形式(原始形式|数字形式)(以列为一条完整的记录) (碰到行,进行行列转置)
'语法: oArrTransArrayNum2 (ByVal oArr)
'参数说明: oArr 需要进行转换的二维数组
'示例: oArrTransArrayNum2 (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrayNum2 (oArr)
End Sub
'###################################################################
oArrTransArrayStr1[返回]
'###################################################################
'函数作用: 一维数组转换成为VBA后台 数组初始化 形式(字符串形式)
'语法: oArrTransArrayStr1 (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrayStr1 (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrayStr1 (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用:二维数组转换成为VBA后台(数组初始化 Array形式)形式 (字符串形式)(以列为一条完整的记录) (碰到行,进行行列转置)
'语法: oArrTransArrayStr2 (ByVal oArr)
'参数说明: oArr 需要进行转换的二维数组
'示例: oArrTransArrayStr2 (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrayStr2 (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用:一维数组转换成为VBA后台(数组初始化 Array形式)形式 (原始形式|数字形式|字符串形式)
'语法: oArrTransArrayNumStr1 (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrayNumStr1 (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrayNumStr1 (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用:二维数组转换成为VBA后台(数组初始化 Array形式)形式 (原始形式|数字形式|字符串形式)
'语法: oArrTransArrayNumStr2 (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrayNumStr2 (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrayNumStr2 (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用: 二维数组转换成为VBA后台(直接转换成二维数组初始化赋值形式)
'语法: oArrTransArrNumStr (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrNumStr (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrNumStr (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用: 全字符形式(全带“引号”的形式)(VB后台使用的内置数组形式)
'语法: oArrTransArrStr (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrStr (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrStr (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用: 全不带“引号”的形式 (VB后台使用的内置数组形式)
'语法: oArrTransArrNum (ByVal oArr)
'参数说明: oArr 需要进行转换的一维数组
'示例: oArrTransArrNum (oArr)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArrTransArrNum (oArr)
End Sub
'###################################################################
'###################################################################
'函数作用: 采用 "不同的分隔符" 将一维数组生成字符串形式
'语法: oArr1TransStr(ByVal oArr, ByVal oStr As String)
'参数说明: oArr 需要进行转换的一维数组
' oStr 生成的字符串的分隔符
'示例: oArr1TransStr (oArr, “#”)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArr1TransStr (oArr, “#”)
End Sub
'###################################################################
'###################################################################
'函数作用: 采用 "不同的分隔符" 将二维数组生成字符串形式
'语法: oArr2TransStr (ByVal oArr, ByVal oStr1 As String, ByVal oStr2 As String)
'参数说明: oArr 需要进行转换的二维数组
' oStr 1 生成的字符串的行分隔符
' oStr 2 生成的字符串的列分隔符
'示例: oArr2TransStr (oArr, “#” , “|”)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArr2TransStr (oArr, “#” , “|”)
End Sub
'###################################################################
'###################################################################
'函数作用: 二维数组+分隔符 变成 一维数组
'语法: oArr2TransArr1 (ByVal oArr, ByVal oChar As String)
'参数说明: oArr 需要进行转换的二维数组
' oChar 分隔符
'示例: oArr2TransArr1 (oArr, “|”)
Sub Demo()
Dim abdata As New vbaArray
Dim oArr
oArr = abdata.oArr2TransArr1 (oArr, “|”)
End Sub
'###################################################################
4.vbaTxt
'###################################################################
'函数作用:新建TXT文件(计算机默认生成格式是 ANSI | VBA生成的文本文件,默认是Gb2312编码(与系统的一致))(如果想变成其他的格式则需要再进一步转换)
'语法: oCreatTxt (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType 'txt文件的类型
'示例: oCreatTxt ("I:\", "12345", "txt")
Sub Demo()
Dim abdata As New vbaTxt
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
Call abdata.oCreatTxt (str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 使用Adodb.Stream判断"文件"编码及进行编码转换(Unicode,Utf-8,GB2312等) '参数:源文件,源文件编码,目标文件,目标文件编码。编码举例----"gb2312"、"UTF-8"等
'语法: oTxtTransCode (ByVal sFile As String, ByVal sCode As String, ByVal dFile As String, ByVal dCode As String)
'参数说明: sFile '源文件
' sCode '源文件编码
' dFile '目标文件
' dCode '目标文件编码
'示例: oTxtTransCode ("I:\txt\ BR.txt ", "gb2312", "I:\txt\ BRBR.txt ", "unicode")
Sub Demo()
Dim str
Dim str2, str3, str4, str5, str6
Dim oString
Dim oString1
Dim oString2
Dim abdata As New vbaTxt
Dim abdata1 As New vbaArray
Dim arr, arr1, arr2
oString = "BaoRui"
str2 = "I:\txt\"
str3 = "BR"
str4 = "txt"
Call abdata.oCreatTxt (str2, str3, str4)
str = str2 & str3 & "." & str4
str5 = "gb2312"
str6 = "unicode" '"UTF-8"
Call abdata.oTxtTransCode (str, str5, str, str6)
End Sub
'###################################################################
'###################################################################
'函数作用:编码转换用 ADO.STREAM 对象,对字符串进行格式转换
'语法: oStringTransCode (ByVal strA As String, ByVal sCode As String, ByVal dCode As String) As String
'参数说明: strA '待进行格式转换的字符串
' sCode '字符串 原本的格式形式
' dCode '字符串 转换成为的格式形式
'示例: oStringTransCode (str, "UTF-8", "ANSI")
Sub Demo()
Dim abdata As New vbaTxt
Dim str
Call abdata.oStringTransCode (str, "ANSI", "UTF-8")
End Sub
'###################################################################
'###################################################################
'函数作用: 判断TXT文件的类型
'语法: oCheckCode1 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType 'txt文件的类型
'示例: oCheckCode1 ("I:\", "12345", "txt")
Sub Demo()
Dim abdata As New vbaTxt
Dim str, str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
str = abdata.oCheckCode1 (str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 判断TXT文件的类型
'语法: oCheckCode2 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType 'txt文件的类型
'示例: oCheckCode2 ("I:\", "12345", "txt")
Sub Demo()
Dim abdata As New vbaTxt
Dim str, str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
str = abdata.oCheckCode2 (str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 向TXT文件写入内容,字符串写入后内容显示"不带引号",覆盖原来txt文件中存在的内容
'语法: oWriteContentIntoTxt1 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oString As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oString '需要写入的字符串
'示例: oWriteContentIntoTxt1 ("I:\", "12345", "txt", str)
Sub Demo()
Dim abdata As New vbaTxt
Dim str, str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
call abdata.oWriteContentIntoTxt1 (str3, str2, str4, str)
End Sub
'###################################################################
'###################################################################
'函数作用: 向TXT文件写入内容,字符串写入后内容显示"不带引号",用vba往txt文件中写东西,怎么样能从空白行开始写?不覆盖原来txt文件中存在的东西。 <逐行(换行)写入内容>
'语法: oWriteContentIntoTxt2 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oString As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oString '需要写入的字符串
'示例: oWriteContentIntoTxt2 ("I:\", "12345", "txt", str)
Sub Demo()
Dim abdata As New vbaTxt
Dim str, str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
call abdata.oWriteContentIntoTxt2 (str3, str2, str4, str)
End Sub
'###################################################################
'###################################################################
'函数作用: 将一个"数组"写入文本文件(批量写入)
'语法: oWriteContentIntoTxt3 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oArr)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oArr '需要写入的(一维)数组形式
'示例: oWriteContentIntoTxt3 ("I:\", "12345", "txt", arr)
Sub Demo()
Dim abdata As New vbaTxt
Dim arr
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
call abdata.oWriteContentIntoTxt3 (str3, str2, str4, arr)
End Sub
'###################################################################
'###################################################################
'函数作用: 字符串写入后内容显示"带引号"
'语法: oWriteContentIntoTxt4 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oString As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oString '需要写入的字符串
'示例: oWriteContentIntoTxt4 ("I:\", "12345", "txt", str)
Sub Demo()
Dim abdata As New vbaTxt
Dim str, str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
call abdata.oWriteContentIntoTxt4 (str3, str2, str4, str)
End Sub
'###################################################################
'###################################################################
'函数作用: 字符串写入后内容显示"带引号",以逐条追加的方式(不覆盖原有的内容)向文本文件中写入内容
'语法: oWriteContentIntoTxt5 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oString As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oString '需要写入的字符串
'示例: oWriteContentIntoTxt5 ("I:\", "12345", "txt", str)
Sub Demo()
Dim abdata As New vbaTxt
Dim str, str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
call abdata.oWriteContentIntoTxt5 (str3, str2, str4, str)
End Sub
'###################################################################
'###################################################################
'函数作用: 字符串写入后内容显示"带引号",将一个"数组"写入文本文件(批量写入)
'语法: oWriteContentIntoTxt6 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oArr)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oArr '需要写入的(一维)数组形式
'示例: oWriteContentIntoTxt6 ("I:\", "12345", "txt", arr)
Sub Demo()
Dim abdata As New vbaTxt
Dim arr
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
call abdata.oWriteContentIntoTxt6 (str3, str2, str4, arr)
End Sub
'###################################################################
'###################################################################
'函数作用: 从TXT文件中读取出字符串内容,将单行字符串数据读取出来,存到一个变量中
'语法: oReadContentFromTxt1 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
'示例: oReadContentFromTxt1 ("I:\", "12345", "txt")
Sub Demo()
Dim abdata As New vbaTxt
Dim str
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
str = abdata.oReadContentFromTxt1 (str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 将多行字符串数据读取出来,存到一个数组变量中
'语法: oReadContentFromTxt2 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
'示例: oReadContentFromTxt2 ("I:\", "12345", "txt")
Sub Demo()
Dim abdata As New vbaTxt
Dim arr
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
arr = abdata.oReadContentFromTxt2 (str3, str2, str4)
End Sub
'###################################################################
'###################################################################
'函数作用: 将TXT字符串数据"数个字符"读取出来,存到一个数组变量中
'语法: oReadContentFromTxt3 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oNumber As String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oNumber '每次读取出来的字符个数
'示例: oReadContentFromTxt3 ("I:\", "12345", "txt",5)
Sub Demo()
Dim abdata As New vbaTxt
Dim arr
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
arr = abdata.oReadContentFromTxt3 (str3, str2, str4,10)
End Sub
'###################################################################
'###################################################################
'函数作用: 建立一个流对象("ADODB.Stream")读取数据,主要是解决读取UTF-8编码文件乱码问题(当然其它格式编码也适用)
'语法: oReadContentFromTxt4 (ByVal parentFolderPath As String, ByVal DocumentName As String, ByVal oType As String, ByVal oCharsetCodeAs String)
'参数说明: parentFolderPath '文件所在的位置(地址路径)
' DocumentName '文件名称
' oType ' txt文件的类型(后缀)
' oCharsetCode '判断的文件的格式
'示例: oReadContentFromTxt4 ("I:\", "12345", "txt","UTF-8")
Sub Demo()
Dim abdata As New vbaTxt
Dim str
Dim str2, str3, str4
str2 = "12345"
str3 = "I:\"
str4 = "txt"
str = abdata.oReadContentFromTxt4 (str3, str2, str4, "ANSI")
End Sub
'###################################################################
5.vbaTxtTrUTF8
'###################################################################
'将一个字符串写入到TXT UTF-8无BOM格式编码 文件
'Public Function WriteStrIntoTxtUTF8(ByVal strPath, ByVal str)
'示例:
Sub Demo()
End Sub
'###################################################################
'###################################################################
'将一个数组(批量)写入到TXT UTF-8无BOM格式编码 文件
'Public Function WriteArrIntoTxtUTF8(ByVal strPath, ByVal arr)
'示例:
Sub Demo()
End Sub
'###################################################################
6.vbaTime
'###################################################################
'函数作用: 程序运行的时间
'语法: oGetTime (ByVal t1 As Single, ByVal t2 As Single)
'参数说明: t1 第一次出现的时间
' t2 第二次出现的时间
'示例: oGetTime (t1, t2)
Sub Demo()
Dim abdata As New vbaArray
Dim T
T = abdata.oGetTime (t1, t2)
End Sub
'###################################################################
'###################################################################
'函数作用: 系统暂停的时间
'语法: oTimeWait (ByVal t1 As Single, ByVal t2 As Single)
'参数说明: t 系统暂停的时间长度
'示例: oTimeWait ( t )
Sub Demo()
Dim abdata As New vbaArray
Call abdata.oTimeWait ( t )
End Sub
'###################################################################
7.vbaSql
'###################################################################
'增|删|改|查+新建表结构+新建字段类型+聚合函数类======增加|删除|修改|查询+新建表结构+新建字段类型+聚合函数类======
'怎么批量读取access中工作表table的名称 以及 怎么判断一个table是否存在 ???
'###################################################################
'###################################################################
'************************************
'通式|解决所有可以用sql语句解决的问题(没有具体设定这个函数的功能,起到灵活补充的作用)
'***不能执行具有“返回值”的sql(查询)语句,能执行“增加|删除|修改|”操作的sql语句***
'参数说明:
'sql 编写的sql语句
'Public Function oGeneralUsing(ByVal sql As String)
'************************************
'删除表:
'Drop table [表名]
'插入数据:
'Insert INTO [表名] (字段1,字段2) VALUES (100,’51WINDOWS.NET’)
'删除数据:
'Delete FROM [表名] Where [字段名]〉100
'更新数据:
'Update [表名] SET [字段1] = 200,[字段2] = ’51WINDOWS.NET’ Where [字段三] = ’HAIWA’
'新增字段:
'Alter TABLE [表名] ADD [字段名] NVARCHAR (50) NULL
'删除字段:
'Alter TABLE [表名] Drop COLUMN [字段名]
'修改字段:
'Alter TABLE [表名] Alter COLUMN [字段名] NVARCHAR (50) NULL
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim sql
Dim str
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
sql = "CREATE TABLE test (CustomerID Single,[Last Name] varchar(10),[First Name] Time)"
'sql = "CREATE INDEX idxCustomerID ON tblCustomers (CustomerID DESC)"
Call abdata.oGeneralUsing(sql)
End Sub
'###################################################################
'###################################################################
'**删除表**
'oTableName 工作表名称
'Public Function oDropTable(ByVal oTableName As String)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim sql
Dim str
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
Call abdata.oDropTable("test")
End Sub
'###################################################################
'###################################################################
'**创建索引**
'CREATE INDEX idxCustomerID ON tblCustomers (CustomerID)
'oTableName 工作表名称(tblCustomers)
'oIndexName 索引名称(idxCustomerID)
'oFieldName 字段名称|表示在哪个字段上建立索引(CustomerID)
'Public Function oCreateIndex(ByVal oTableName As String, ByVal oIndexName As String, ByVal oFieldName As String)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim sql
Dim str
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
Call abdata.oCreateIndex("test", "IndexCustomerID", "CustomerID")
End Sub
'###################################################################
'###################################################################
'**删除索引**
'DROP INDEX idxName ON tblCustomers
'oTableName 工作表名称(tblCustomers)
'oIndexName 索引名称(idxCustomerID)
'Public Function oDropIndex(ByVal oTableName As String, ByVal oIndexName As String)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim sql
Dim str
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
Call abdata.oDropIndex("test", "IndexCustomerID")
End Sub
'###################################################################
'###################################################################
'**判断Access中工作表是否存在**
'参数说明:oTableName 判断的工作表名称
'oTableExisits = oNum
'oNum = 1 '报错了,说明相同的工作表名称是存在的
'oNum = 0 '没错了,说明相同的工作表名称是不存在
'Public Function oTableExisits(ByVal oTableName As String)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim oTBName As String
Dim sql As String
Dim arr
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
oTBName = "ABDATA" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
MsgBox abdata.oTableExisits(oTBName)
End Sub
'###################################################################
'###################################################################
'**新建表结构+新建字段类型**
'参数说明:oTableName 新建工作表名称
'oFieldNameArr 字段名称一维数组
'oFieldTypeArr 字段属性一维数组
'属性示例:
'Byte|数字[字节]
'Long|数字[长整型]
'Short|数字[整型]
'Single|数字[单精度]
'Double|数字[双精度]
'Currency|货币
'Char|文本
'Text(n)|文本,其中n表示字段大小
'varchar(n)|字符串,后面可以带括号来表示长度
'Binary|二进制
'Counter|自动编号
'Memo|备注
'Time|日期/时间
'Public Function oCreatTable(ByVal oTableName As String, ByVal oFieldNameArr, ByVal oFieldTypeArr)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim oName
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
oName = "baorui" 'abdata
arr1 = Array("CustomerID", "[Last Name]", "[First Name]", "Phone", "Email", "BaoRui1", "BaoRui2", "BaoRui3", "BaoRui4", "BaoRui5", "BaoRui6", "BaoRui7", "BaoRui8")
arr2 = Array("Byte", "Long", "Short", "Single", "Double", "Currency", "Char", "Text(10)", "varchar(10)", "Binary", "Counter", "Memo", "Time")
Call abdata.oCreatTable(oName, arr1, arr2)
End Sub
'###################################################################
'###################################################################
'**增加**
'二维数组数据增加|插入
'INSERT INTO tbCustomers (CustomerID, [Last Name], [First Name]) VALUES (1, 'Kelly', 'Jill')
'插入数据时分为三大类:
'日期型(Time)(""""+日期型+"""")
'文本型(Char|Text(n)|varchar(n)|Memo)("'"+文本型+"'")
'数字型(Byte|Long|Short|Single|Double|Currency)
'参数说明:oTableName 新建工作表名称
'oFieldNameArr 字段名称一维数组
'oFieldTypeArr 字段属性一维数组
'oDataArr 数据二维数组
'Public Function oInsertData(ByVal oTableName As String, ByVal oFieldNameArr, ByVal oFieldTypeArr, ByVal oDataArr)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim abdata1 As New vbaExcel
Dim sql
Dim oName
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
oName = "test" 'abdata
arr1 = Array("CustomerID", "[Last Name]", "[First Name]")
'arr2 = [{1, "'Kelly'", "'2014-11-14'"; 2, "'Kelly'", "'2014-11-14'"; 3, "'Kelly'", "'2014-11-14'"; 4, "'Kelly'", "'Jill'"; 5,"'Kelly'", "'Jill'"; 6,"'Kelly'", "'Jill'"}]
'arr2 = [{1, "'Kelly'", "#2014-11-14#"; 2, "'Kelly'", "#2014-11-14#"; 3, "'Kelly'", "#2014-11-14#"}]
arr2 = Array("Single", "varchar(10)", "Time")
arr3 = abdata1.oDataTransArr2("Sheet2", "A1")
'sql = "INSERT INTO test (CustomerID, [Last Name], [First Name]) VALUES (2, 'Kelly', 'Jill')"
Call abdata.oInsertData(oName, arr1, arr2, arr3)
End Sub
'###################################################################
'###################################################################
'**查询**
'1.一维数组数据查询|Access的相关属性信息
'oTBName 数据库工作表的名称 | 组成sql语句 |sql = SELECT * FROM oTBName|
'oType oType="Name" "N"| 列出数据库所有的"字段名称"
'oType oType="Type" "T"| 列出数据库所有的"字段名称"的数据类型
'oType oType="DefinedSize" "D"| 列出数据库所有的字段名称的数据类型所对应的数据字段大小
'Public Function oGetTypeSize(ByVal oTBName As String, ByVal oType As String)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim sql
Dim str
Dim arr1, arr2, arr3
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
abdata.TBName = "statistics_base_1" '"countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
str = "北京"
'sql = "SELECT * FROM " & abdata.TBName '& " WHERE ucityname = '成都' " '& str
arr1 = abdata.oGetTypeSize(abdata.TBName, "N")
arr2 = abdata.oGetTypeSize(abdata.TBName, "T")
arr3 = abdata.oGetTypeSize(abdata.TBName, "D")
End Sub
'###################################################################
'###################################################################
'2.数据查询|聚合函数类计算|结果表现形式:二维数组
'*************************************************
'数据查询:
'● 结构化查询语言(Structured Query Language)。这种语言的语法结构类似于英语,易学易用,书写随意。
'在SQL语言中,使用SELECT语句进行数据库的查询时,应用灵活、
'功能强大?
'1 基本格式
'SELECT [ ALL | DISTINCT | TOP ] <字段表达式1> [,<字段表达式2> [,…] ]
'FROM <表名1> [,<表名1> [,...] ]
'[ WHERE <筛选条件表达式> ]
'[ GROUP BY <分组表达式> [ HAVING <分组条件表达式> ] ]
'[ ORDER BY <字段> [ ASC | DESC ] ]
'2 语句说明
'● SELECT语句的基本格式是由SELECT子句、FROM子句和WHERE子句组成的查询块。
'● 整个SELECT语句的含义是:根据WHERE子句的筛选条件表达式,从FROM子句指定的表中找出满足条件记录,再按SELECT语句中指定的字段次序,筛选出记录中的字段值构造一个显示结果表。
'● 如果有GROUP子句,则将结果按<分组表达式>的值进行分组,该值相等的记录为一个组。
'● 如果GROUP子句带HAVING短语,则只有满足指定条件的组才会显示输出。
'● 如果ORDER子句 ASC 升序 DESC 降序
'提示:SELECT语句操作的是记录(数据)集合(一个表或多个表),而不是单独的一条记录。语句返回的也是记录集合(满足Where条件的),即结果表。
'● SELECT子句后的各个字段的先后顺序可以与原表中的顺序不一致,但在结果表中,字段是按照SELECT子句后的各个字段的顺序显示。
'● 在SELECT语句中,可以使用通配符“*”显示所有的字段
'● 在SELECT语句中,可以在一个字段的前面加上一个单引号字符串,对后面的字段起说明作用。
'*************************************************
'聚合函数类计算:
'SUM|求和
'AVG|平均值
'COUNT()|表达式中记录的数目
'COUNT(*)|计算记录的数目
'Max|最大值
'Min|最小值
'VAR|返回某列的样本方差(样本|除 n-1 )
'VARP|返回某列的总体方差(总体|除 n )
'STDEV|返回某列的样本标准差(样本|除 n-1 )
'STDEVP|返回某列的总体标准差(总体|除 n )
'FIRST|第一个值
'LAST|最后一个值
'*************************************************
'Public Function oGetData(ByVal sql As String)
'示例:
Sub Demo()
Dim abdata As New vbaSql
Dim sql1, sql2
Dim str
Dim arr1, arr2
abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
abdata.DataName = "oStatisticsData20141112" '数据库名称
abdata.TBName = "countTJ_1" '数据库工作表名称
abdata.oOpen (abdata.AdoConnString(Access2010))
str = "'上海'"
sql1 = "SELECT distinct ucityname FROM " & abdata.TBName ' & " WHERE ucityname = " & str
sql2 = "SELECT max(oCount) FROM " & abdata.TBName ' & " WHERE ucityname = " & str
arr1 = abdata.oGetData(sql1)
arr2 = abdata.oGetData(sql2)
End Sub
'###################################################################
8.vbaAccess
'###################################################################
'oGetData|oAccessGetData
'第一部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName|(需要提取|查询数据)数据库工作表名称|ParameterArr(2)
'sql|获取access数组数据的sql语句
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "countTJ_1" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessGetData(ByVal ParameterArr, ByVal sql As String)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim sql
Dim arr, arr1
Dim str, str4 As String
Dim oPath, oDBName, oTBName As String
str = "'北京'"
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "countTJ_1" '数据库工作表名称
'sql = "SELECT max(oCount) FROM " & str3 & " WHERE ucityname = " & str
sql = "SELECT distinct ucityname FROM " & oTBName '& " WHERE ucityname = " & str
arr1 = Array(oPath, oDBName, oTBName)
'str = "'上海'"
'sql1 = "SELECT distinct ucityname FROM " & abdata.TBName ' & " WHERE ucityname = " & str
'sql2 = "SELECT max(oCount) FROM " & abdata.TBName ' & " WHERE ucityname = " & str
'arr1 = abdata.oGetData(sql1)
arr = abdata.oAccessGetData(arr1, sql)
End Sub
'###################################################################
'###################################################################
'oInsertData|oAccessInsertData
'第二部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName|(需要增加|插入数据)数据库工作表名称|ParameterArr(2)
'oFieldNameArr 字段名称一维数组
'oFieldTypeArr 字段属性一维数组
'oDataArr 数据二维数组
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessInsertData(ByVal ParameterArr, ByVal oFieldNameArr, ByVal oFieldTypeArr, ByVal oDataArr)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim abdata1 As New vbaExcel
Dim sql
Dim oName
Dim arr, arr1, arr2, arr3
Dim oPath, oDBName, oTBName As String
Dim str4 As String
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "test" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
'oFieldNameArr
arr1 = Array("CustomerID", "[Last Name]", "[First Name]")
'oFieldTypeArr
arr2 = Array("Single", "varchar(10)", "Time")
arr3 = abdata1.oDataTransArr2("Sheet2", "A1")
'sql = "INSERT INTO test (CustomerID, [Last Name], [First Name]) VALUES (2, 'Kelly', 'Jill')"
Call abdata.oAccessInsertData(arr, arr1, arr2, arr3)
End Sub
'###################################################################
'###################################################################
'oGetTypeSize|oAccessGetTypeSize
'第三部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要提取类型的工作表名称)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称 | 组成sql语句 |sql = SELECT * FROM oTBName|
'oType oType="Name" "N"| 列出数据库所有的"字段名称"
'oType oType="Type" "T"| 列出数据库所有的"字段名称"的数据类型
'oType oType="DefinedSize" "D"| 列出数据库所有的字段名称的数据类型所对应的数据字段大小
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "countTJ_1" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessGetTypeSize(ByVal ParameterArr, ByVal oType As String)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim sql
Dim arr, arr1, arr2, arr3
Dim oPath, oDBName, oTBName As String
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "test" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
arr1 = abdata.oAccessGetTypeSize(arr, "N")
arr2 = abdata.oAccessGetTypeSize(arr, "T")
arr3 = abdata.oAccessGetTypeSize(arr, "D")
Dim abdata1 As New vbaExcel
'Call abdata1.oArrTransDataS1(arr1, "Sheet3", "H1")
'Call abdata1.oArrTransDataS1(arr2, "Sheet3", "I1")
'Call abdata1.oArrTransDataS1(arr3, "Sheet3", "J1")
End Sub
'###################################################################
'###################################################################
'oCreatTable|oAccessCreatTable
'第四部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要创建的工作表名称)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称
'oFieldNameArr 字段名称一维数组
'oFieldTypeArr 字段属性一维数组
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessCreatTable(ByVal ParameterArr, ByVal oFieldNameArr, ByVal oFieldTypeArr)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim oPath, oDBName, oTBName As String
Dim arr, arr1, arr2
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "baorui" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
'oFieldNameArr
arr1 = Array("CustomerID", "[Last Name]", "[First Name]", "Phone", "Email", "BaoRui1", "BaoRui2", "BaoRui3", "BaoRui4", "BaoRui5", "BaoRui6", "BaoRui7", "BaoRui8")
'oFieldTypeArr
arr2 = Array("Byte", "Long", "Short", "Single", "Double", "Currency", "Char", "Text(10)", "varchar(10)", "Binary", "Counter", "Memo", "Time")
Call abdata.oAccessCreatTable(arr, arr1, arr2)
End Sub
'###################################################################
'###################################################################
'oDropIndex|oAccessDropIndex
'第五部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要增加|插入数据)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称 | 工作表名称(tblCustomers)
'oIndexName 索引名称(idxCustomerID)
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessDropIndex(ByVal ParameterArr, ByVal oIndexName As String)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim oPath, oDBName, oTBName As String
Dim arr
Dim indexname As String
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "baorui" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
indexname = "idxCustomerID"
Call abdata.oAccessDropIndex(arr, indexname)
End Sub
'###################################################################
'###################################################################
'oCreateIndex|oAccessCreateIndex
'第六部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要增加|插入数据)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称 | 工作表名称(tblCustomers)
'oIndexName 索引名称(idxCustomerID)
'oFieldName 字段名称|表示在哪个字段上建立索引(CustomerID)
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessCreateIndex(ByVal ParameterArr, ByVal oIndexName As String, ByVal oFieldName As String)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim oPath, oDBName, oTBName As String
Dim arr
Dim indexname, fieldname As String
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "baorui" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
indexname = "idxCustomerID"
fieldname = "CustomerID"
Call abdata.oAccessCreateIndex(arr, indexname, fieldname)
End Sub
'###################################################################
'###################################################################
'oDropTable|oAccessDropTable
'第七部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要增加|插入数据)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称 | 工作表名称(tblCustomers)| oTableName
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessDropTable(ByVal ParameterArr)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim oPath, oDBName, oTBName As String
Dim arr
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "baorui" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
Call abdata.oAccessDropTable(arr)
End Sub
'###################################################################
'###################################################################
'oGeneralUsing|oAccessGeneralUsing
'第八部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要增加|插入数据)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称 | 工作表名称(tblCustomers)| oTableName
'sql 编写的sql语句
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessGeneralUsing(ByVal ParameterArr, ByVal sql As String)
'示例:
Sub Demo()
'On Error Resume Next
Dim abdata As New vbaAccess
Dim oPath, oDBName, oTBName As String
Dim sql As String
Dim arr
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
'sql = "CREATE TABLE ABDATA (abdata text(6))"
sql = "DROP TABLE ABDATA"
Call abdata.oAccessGeneralUsing(arr, sql)
End Sub
'###################################################################
'###################################################################
'oTableExisits|oAccessTableExisits
'第九部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName=oTBName|(需要创建的工作表名称)数据库工作表名称|ParameterArr(2)
'oTBName=abdata.TBName 数据库工作表的名称
'oAccessTableExisits 返回值是1,表示存在
'oAccessTableExisits 返回值是0,表示不存在
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessTableExisits(ByVal ParameterArr)
'示例:
Sub Demo()
Dim abdata As New vbaAccess
Dim oPath, oDBName, oTBName As String
Dim sql As String
Dim arr
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "ABDATA" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
MsgBox abdata.oAccessTableExisits(arr)
End Sub
'###################################################################
9.vbaToArrayTo
'###################################################################
'txt To array
'第一部分
'参数说明:
'arr1 路径名称等变量参数数组(一维)
'arr2 字符串分隔符参数数组(一维、二列)||说明:chr(10) 可以生成换行符|chr(13) 可以生成回车符|vbcrlf 换行符和回车符|vbCr 等同于chr(10)|vblf 等同于chr(13)
'参数arr1举例 arr1(0)="C:\Users\abdata\Desktop\"|arr1(1)="2013-08-01_2014-10-31brV1"|arr1(2)="UTF-8"
'参数arr2举例 arr2(0)="vblf" | arr2(1)="$"
'Public Function oTxtToArray1(ByVal arr1, ByVal arr2)
'示例:
Sub Demo()
End Sub
'###################################################################
'###################################################################
'excel To array
'第二部分
'参数说明:
'arr 工作表名称、单元格位置、单元格位置所在的列数 等变量参数数组(一维)
'oNum 不同的参数代表读取不同方式不同维数的数组|oNum=0代表读取二维数组 # oNum=1代表横向读取一维数组 # oNum=2代表纵向读取一维数组
'参数arr举例 arr(0)="oSheet" | arr(1)="C1" | arr(2)="3"
'参数oNum举例 oNum=0 | oNum=1 | oNum=2
'Public Function oExcelToArray(ByVal arr, ByVal oNum)
'示例:
Sub Demo()
End Sub
'###################################################################
'###################################################################
'access To array
'第三部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName|(需要提取|查询数据)数据库工作表名称|ParameterArr(2)
'sql|获取access数组数据的sql语句
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "countTJ_1" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oAccessToArray(ByVal ParameterArr, ByVal sql As String)
'示例:
Sub Demo()
Dim abdata As New vbaToArrayTo
Dim sql
Dim arr, arr1
Dim str, str4 As String
Dim oPath, oDBName, oTBName As String
str = "'北京'"
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "countTJ_1" '数据库工作表名称
'sql = "SELECT max(oCount) FROM " & str3 & " WHERE ucityname = " & str
sql = "SELECT distinct ucityname FROM " & oTBName '& " WHERE ucityname = " & str
arr1 = Array(oPath, oDBName, oTBName)
'str = "'上海'"
'sql1 = "SELECT distinct ucityname FROM " & abdata.TBName ' & " WHERE ucityname = " & str
'sql2 = "SELECT max(oCount) FROM " & abdata.TBName ' & " WHERE ucityname = " & str
'arr1 = abdata.oGetData(sql1)
arr = abdata.oAccessToArray(arr1, sql)
End Sub
'###################################################################
'###################################################################
'array To txt
'第四部分
'参数说明:
' !!! 根据具体的需求待定 !!!
'Public Function oArrayToTxt(ByVal oDataArr, ByVal arr1, ByVal arr2)
'示例:
Sub Demo()
End Sub
'###################################################################
'###################################################################
'array To excel
'第五部分
'参数说明:
'oDataArr 需要转换成data形式的数组(一位或二维)
'arr 工作表名称、单元格位置、单元格位置所在的列数 等变量参数数组(一维)
'oNum 不同方式不同维数的数组转换成为data形式 | oNum=0代表读取二维数组 # oNum=1代表横向读取一维数组 # oNum=2代表纵向读取一维数组
'参数arr举例 arr(0)="oSheet" | arr(1)="C1" | arr(2)="3"
'参数oNum举例 oNum=0 | oNum=1 | oNum=2
'Public Function oArrayToExcel(ByVal oDataArr, ByVal arr, ByVal oNum)
'示例:
Sub Demo()
End Sub
'###################################################################
'###################################################################
'array To access
'第六部分
'***************************************************
'参数说明:
'abdata.DataPath|数据库路径|ParameterArr(0)
'abdata.DataName|数据库名称|ParameterArr(1)
'abdata.TBName|(需要增加|插入数据)数据库工作表名称|ParameterArr(2)
'oFieldNameArr 字段名称一维数组
'oFieldTypeArr 字段属性一维数组
'oDataArr 数据二维数组
'***************************************************
'示例:
'abdata.DataPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
'abdata.DataName = "oStatisticsData20141112" '数据库名称
'abdata.TBName = "test" '数据库工作表名称
'abdata.oOpen (abdata.AdoConnString())
'***************************************************
'Public Function oArrayToAccess(ByVal ParameterArr, ByVal oFieldNameArr, ByVal oFieldTypeArr, ByVal oDataArr)
'示例:
Sub Demo()
Dim abdata As New vbaToArrayTo
Dim abdata1 As New vbaExcel
Dim sql
Dim oName
Dim arr, arr1, arr2, arr3
Dim oPath, oDBName, oTBName As String
Dim str4 As String
oPath = "C:\Users\abdata\Desktop\20141105\20141111 postgres\" '数据库路径
oDBName = "oStatisticsData20141112" '数据库名称
oTBName = "test" '"countTJ_1" '数据库工作表名称
arr = Array(oPath, oDBName, oTBName)
arr1 = Array("CustomerID", "[Last Name]", "[First Name]")
arr2 = Array("Single", "varchar(10)", "Time")
arr3 = abdata1.oDataTransArr2("Sheet2", "A1")
'sql = "INSERT INTO test (CustomerID, [Last Name], [First Name]) VALUES (2, 'Kelly', 'Jill')"
Call abdata.oArrayToAccess(arr, arr1, arr2, arr3)
End Sub
'###################################################################