在EXCEL中使用SQL语句查询集锦-持续更新中，敬请关注

opiona

在原来基础上增加了   加密函数   FTP上传下载函数

试用到 2022-05-31

DLL插件ExcelToSQL.rar (322.43 KB, 下载次数: 73)

2021-12-20 17:03 上传

点击文件名下载附件

boon

多谢楼主分享！

游乐缘

感谢分享，留名学习

opiona

ACCESS保存文件.rar (144.55 KB, 下载次数: 96)

2022-3-27 09:46 上传

点击文件名下载附件

ACCESS中保存图片 或者文件

1. Sub A_保存()
   
2.     Dim CN As ADODB.Connection
   
3.     Dim RS As ADODB.Recordset
   
4.     Set CN = New ADODB.Connection
   
5.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;;data source=" & ThisWorkbook.Path & "\Database.mdb"
   
6.     CN.ConnectionString = Str_coon
   
7.     CN.Open
   
8.     Set RS = New ADODB.Recordset
   
9.     RS.Open "select 学生编号,相片 from [table1]", CN, adOpenStatic, adLockOptimistic
   
10.     Set FSO = CreateObject("Scripting.FileSystemObject")
    
11.     Dim mst As ADODB.Stream
    
12.     Set SHX = Worksheets("登记表")
    
13.     For I = 2 To SHX.Range("A65536").End(3).Row
    
14.         RS.AddNew
    
15.         RS.Fields("学生编号").Value = SHX.Cells(I, 1).Value
    
16.         Rem  判断文件是否存在
    
17.         Path = ThisWorkbook.Path & "\原始图片" & SHX.Cells(I, 1).Value & ".png"
    
18.         If FSO.FileExists(Path) = True Then
    
19.             Set mst = New ADODB.Stream
    
20.             mst.Type = adTypeBinary
    
21.             mst.Open
    
22.             mst.LoadFromFile Path
    
23.             RS.Fields("相片").Value = mst.Read
    
24.         Else
    
25.             RS.Fields("相片").Value = Null
    
26.         End If
    
27.         RS.Update
    
28.     Next
    
29.     RS.Close
    
30.     CN.Close
    
31.     MsgBox "已添加", , "北极狐QQ：14885553"
    
32. End Sub

复制代码

1. Sub B_下载()
   
2.     Path = ThisWorkbook.Path & "\下载"
   
3.     Set FSO = CreateObject("Scripting.FileSystemObject")
   
4.     If FSO.FolderExists(Path) = False Then
   
5.         MkDir Path    '//创建文件夹
   
6.     End If
   
7.     Dim CN, RS
   
8.     Set CN = New ADODB.Connection
   
9.     Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;;data source=" & ThisWorkbook.Path & "\Database.mdb"
   
10.     CN.ConnectionString = Str_coon
    
11.     CN.Open
    
12.     Set RS = New ADODB.Recordset
    
13.     StrSQL = "select 学生编号,相片 from [table1]"
    
14.     RS.Open StrSQL, CN, adOpenKeyset, adLockBatchOptimistic
    
15.     Set SHX = Worksheets("登记表")
    
16.     SHX.Range("A2:B65536").ClearContents
    
17.     I = 1
    
18.     Do While Not RS.EOF
    
19.         I = I + 1
    
20.         SHX.Cells(I, 1).Value = RS.Fields("学生编号").Value '显示第一标题下每一条的内容
    
21.         If IsNull(RS.Fields("相片").Value) = True Then
    
22.             SHX.Cells(I, 2).Value = "无照片"
    
23.         Else
    
24.             SHX.Cells(I, 2).Value = RS.Fields("学生编号").Value
    
25.             Rem 写入文件
    
26.             Set mst = New ADODB.Stream
    
27.             mst.Type = adTypeBinary
    
28.             mst.Open
    
29.             mst.Write RS.Fields("相片").Value
    
30.             mst.SaveToFile ThisWorkbook.Path & "\下载" & SHX.Cells(I, 1).Value & ".PNG", adSaveCreateOverWrite    '保存文件，adSaveCreateOverWrite为覆盖以存在文件
    
31.         End If
    
32.         RS.MoveNext
    
33.     Loop
    
34.     RS.Close
    
35.     CN.Close
    
36.     MsgBox "已显示，并下载", , "北极狐QQ：14885553"
    
37. End Sub
    

复制代码

yusihai719

学习。谢谢分享。

opiona

最新版DLL 有效期到  2023-05-31

DLL插件ExcelToSQL函数示例-20220601.rar (812.58 KB, 下载次数: 92)

2022-6-5 10:00 上传

点击文件名下载附件

siwing

好贴，值得收藏

opiona

加入 MySqlBulkLoader功能  
MySQL可以导入CSV 上传速度变的很快   
5个字段 上传至腾讯云数据库  十万行 需要3秒, 百万行 需要40秒

但是需要权限  SET GLOBAL local_infile=1；//1表示开启，0表示关闭
有效期到 2023-07-31

DLL插件ExcelToSQL函数示例-QQ14885553.rar (817.79 KB, 下载次数: 127)

2022-8-1 13:29 上传

点击文件名下载附件

sjwxsdj

正在学习，感谢楼主。

zglibk

收藏等于学会！