基于VBA for Excel批量下载图片教程系列（十六）——数

在 基于VBA for Excel批量下载图片教程系列（十四）——获取文件MD5值 一文中，我们讲到了获取图片MD5值的目的，即在下载之前通过比较待下载图片与已下载图片的MD5值，确定是否已经下载，若待下载图片已经存在，则取消下载，若不存在，则继续下载。

要完成上述任务，关键在于以下两点：

• 1、已下载图片的MD5数据库；

• 2、下载之前的快速查询。

针对上述两个关键问题，下面分别介绍比较简单和比较复杂的两种方法。

1 文本文件做数据库

这是一种很常见也很简单的方法，具体思路如下：

• 1、在下载过程中，将图片的MD5值和图片的PathName写入一个专门的文本文键，如Database;

• 2、当另一次下载开始之前，读取Database中的MD5和PathName，生成一个以MD5为关键字的字典；

• 3、下载开始后，使用待下载图片的MD5值查找字典中是否存在该关键字，若存在则取消下载，若不存在，则继续下载。

1.1 生成数据库函数

例如，数据库文件存放于工作表所在目录（假设为"D:\Tools"），使用如下代码写入MD5和FilePathName：

Open ThisWorkbook.Path & "\" & "Database" For Append As #1  '使用append方式时，若目标文件不存在，则新建；若存在，则以追加写入的方式打开
Write #2, MD5, LocalFilePathName
Close #2

Database中部分内容如下：

"c73ef139dc326bfe44671b2a3a6592f2","D:\tmp\New\001.jpg"
"e089a63da926264384b30e3d4830cb60","D:\tmp\New\003.jpg"
"9188c9c5fbb92efcca31005c50de6e32","D:\tmp\New\004.jpg"
"9a7309ba5528c67e61d1c55b362107af","D:\tmp\New\005.jpg"
"74ded0b957729156ed8affc3f296b7b3","D:\tmp\New\006.jpg"
"0d001507f5d9f2177752763a1d4b0f69","D:\tmp\New\007.jpg"
"b4b6d8ec0eb0847ffc14bc3b1fe6f107","D:\tmp\New\008.jpg"
"77d262d4aa57ab1a2bf67643963d4e2f","D:\tmp\New\009.jpg"
"3700424762aad119eb2d1ffc6b03ad6c","D:\tmp\New\010.jpg"
"f181a91ffa71fe331ebc830ae728cd70","D:\tmp\New\011.jpg"
"df9ea0ef6aac50f3b78c180b41b3b89b","D:\tmp\New\012.jpg"
"9afafdf37c25ed6b9e1eac3a3f910156","D:\tmp\New\013.jpg"
"6e4cba5a6ed25d5f66e21c6ae0698303","D:\tmp\New\014.jpg"
"d7c6ece0def9fa9c5e58928c05a2f683","D:\tmp\New\015.gif"
    ……

假设，我们某次下载了616张图片，存放在 "D:\tmp\New" 中，并且在下载过程中将所有的图片MD5值和FilePathName写入了Database。新的下载开始之前，我们使用Input语句将MD5和FilePathName读入变量中，最后生成字典：

Dim sDictionary As Object
Set sDictionary = CreateObject("Scripting.Dictionary")
Open "d:\Tools\Database" For Input As #1
Do While Not EOF(1)
    Input #1, md5, filepath
    sDictionary.Add md5, filepath
Loop
Close #1

当下载开始，在获取了待下载图片的MD5值后，我们在字典中查找是否存在这个关键字（假设为"3700424762aad119eb2d1ffc6b03ad6c"）：

If sDictionary.Item("3700424762aad119eb2d1ffc6b03ad6c") <> Empty Then
 MsgBox sDictionary.Item("3700424762aad119eb2d1ffc6b03ad6c")
Else
 MsgBox "不存在"
End If

运行后显示 "D:\tmp\New\010.jpg"。

那么什么是字典呢？

1.2 字典（Dictionary）

字典是Excel VBA中的一个非常有用的对象，其应用最广泛的地方在于去重复。

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）组成。

1.2.1 字典的声明

Dim sDictionary As Object
Set sDictionary = CreateObject("Scripting.Dictionary")

1.2.2 方法

字典对象有六个方法，分别是Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。

• 1、Add方法

向 Dictionary 对象中添加一个关键字项目对。

语法：object.Add (key, item)

在1.1的例子中，我们使用了Add方法，如下：

sDictionary.Add md5, filepath

代码表示，为字典对象sDictionary添加关键字md5，对应的项为filepath。

注意：由于字典关键字（Key）具有唯一性，使用Add方法时添加一个已经存在的Key时，会导致错误。

• 2、Exists方法

返回一个Boolean值，如果 Dictionary 对象中存在所指定的关键字则返回 true，否则返回 false。

语法：object.Exists(key)

例如，

sDictionary.Add "a","Apple"
sDictionary.Add "b","Blue"
sDictionary.Add "c","China"
MsgBox sDictionary.Exists("a")
MsgBox sDictionary.Exists("d")

运行后，显示"True"和"False"。

• 3、Keys方法

返回一个以字典关键字为元素的数组。

语法：object.Keys( )

例如，

Dim Arr '需要定义为Variant类型
sDictionary.Add "a","Apple"
sDictionary.Add "b","Blue"
sDictionary.Add "c","China"
Arr=sDictionary.Keys()
MsgBox Arr(0)
MsgBox Arr(1)
MsgBox Arr(2)

运行后分别返回"a"、"b"、"c"，获取的数组Arr()默认下限为0。

• 4、Items方法

返回一个以字典项为元素的数组。

语法：object.Items( )

例如，

Dim Arr '需要定义为Variant类型
sDictionary.Add "a","Apple"
sDictionary.Add "b","Blue"
sDictionary.Add "c","China"
Arr=sDictionary.Items()
MsgBox Arr(0)
MsgBox Arr(1)
MsgBox Arr(2)

运行后分别返回"Apple"、"Blue"、"China"。

• 5、Remove方法

从一个 Dictionary 对象中清除一个关键字，项目对。

语法：object.Remove(key)

其中 object 总是一个 Dictionary 对象的名称。

key，必选项。key 与要从 Dictionary 对象中删除的关键字，项目对相关联。

说明：如果所指定的关键字，项目对不存在，那么将导致一个错误。

例如，

sDictionary.Add "a", "Apple"
sDictionary.Add "b", "Blue"
sDictionary.Add "c", "China"
sDictionary.Remove ("a")
MsgBox sDictionary.Item("a")

运行后，将返回一个空值。

• 6、RemoveAll方法

从一个 Dictionary 对象中清除所有的关键字，项目对。

语法：object.RemoveAll( )

例如，

sDictionary.Add "a", "Apple"
sDictionary.Add "b", "Blue"
sDictionary.Add "c", "China"
sDictionary.RemoveAll

1.2.3 属性

字典对象有4个属性，分别为Count属性、Key属性、Item属性、CompareMode属性。

• 1、Count属性

返回一个Dictionary 对象中的项目数。只读属性。

语法：object.Count

例如，

sDictionary.Add "a", "Apple"
sDictionary.Add "b", "Blue"
sDictionary.Add "c", "China"
MsgBox sDictionary.Count

返回值为3。

• 2、Key属性

在 Dictionary 对象中设置一个新 key。

语法：object.Key(key) = newkey

其中，key为必选项，被改变的 key 值。newkey为必选项。替换所指定的 key 的新值。

说明：如果在改变一个 key 时没有发现该 key，那么将创建一个新的 key 并且其相关联的 item 被设置为空。

例如，

sDictionary.Add "a", "Apple"
sDictionary.Add "b", "Blue"
sDictionary.Add "c", "China"
sDictionary.Key("a") = "d"
MsgBox sDictionary.Item("d")

运行后返回值为"Apple"。

• 3、Item属性

在一个 Dictionary 对象中设置或者返回所指定 key 的 item。对于集合则根据所指定的 key 返回一个 item。读/写。

语法：object.Item(key)[ = newitem]

其中，key为必选项，与要被查找或添加的item相关联的key。newitem为可选项，只有在写的状态下才使用newitem，用于修改与之相对应Key的项值。

说明：如果在改变一个 key 的时候没有找到该 item，那么将利用所指定的 newitem 创建一个新的 key。如果在试图返回一个已有项目的时候没有找到 key，那么将创建一个新的 key 且其相关的项目被设置为空。

例如，

sDictionary.Add "a", "Apple"
sDictionary.Add "b", "Blue"
sDictionary.Add "c", "China"
MsgBox sDictionary.Item("b")  '读状态，返回关键字"b"所对应的项值
sDictionary.Item("c") = "Canada" '写状态，将关键字"c"所对应的的项值修改为"Canada"
MsgBox sDictionary.Item("c")
MsgBox sDictionary.Item("d") '读取不存在的关键字"d"所对应的项值，为空
sDictionary.Item("d") = "Dog" '写入一个不存在的关键字"d"，并将其项值赋值为"Dog"，该功能与 sDictionary.Add "d","Dog"一样
MsgBox sDictionary.Item("d")

上面的代码特别需要注意：

sDictionary.Item("d") = "Dog"

与

sDictionary.Add "d","Dog"

这两行代码是完全相同的作用，很多情况下可以使用Item的写状态来创建字典，例如1.1中创建字典可以如下：

sDictionary.Item(md5) = filepath

• 4、CompareMode属性

设置或者返回在 Dictionary 对象中进行字符串关键字比较时所使用的比较模式。

语法：object.CompareMode[ = compare]

其中，compare为可选项。如果提供了此项，compare 就是一个代表比较模式的值。可以使用的值是 0 (二进制)、1 (文本), 2 (数据库)。

说明：如果试图改变一个已经包含有数据的 Dictionary 对象的比较模式，那么将导致一个错误。即，该属性只能在声明字典后立即使用，而不能在添加了关键字和项值后使用

例如，

Dim sDictionary As Object
Set sDictionary = CreateObject("Scripting.Dictionary")
sDictionary.CompareMode = 1 '以文本形式比较    
sDictionary.Item("a") = "Apple"
sDictionary.Item("b") = "Banana"
sDictionary.Add "A", "April"

运行后提示错误“该关键字已经与该集合的一个元素相关联”。

Dim sDictionary As Object
Set sDictionary = CreateObject("Scripting.Dictionary")
sDictionary.CompareMode = 0 '以二进制形式比较

sDictionary.Item("a") = "Apple"
sDictionary.Item("b") = "Banana"
sDictionary.Add "A", "April"

正常运行。

此外，我们需要注意下面的代码：

Dim sDictionary As Object
Set sDictionary = CreateObject("Scripting.Dictionary")
sDictionary.CompareMode = 1 '以文本形式比较

sDictionary.Item("a") = "Apple"
sDictionary.Item("b") = "Banana"
sDictionary.Item("A") = "April"
MsgBox sDictionary.Item("a")
MsgBox sDictionary.Item("A")

运行返回值为"April"、"April"。为何会如此呢？这是因为以文本形式比较关键字时，不区分字母的大小写，"a"和"A"完全一样；同时，使用Item属性而不是Add方法为关键字赋值，程序会将"A"看做"a"，改变了字典中关键字"a"的项值。

因此，使用Item属性创建字典，建议使用二进制形式比较，这样会避免出现问题，例如，

Dim sDictionary As Object
Set sDictionary = CreateObject("Scripting.Dictionary")
sDictionary.CompareMode = 0 '以二进制形式比较

sDictionary.Item("a") = "Apple"
sDictionary.Item("b") = "Banana"
sDictionary.Item("A") = "April"
MsgBox sDictionary.Item("a")
MsgBox sDictionary.Item("A")

返回值分别为"Apple"、"April"。

2 创建.mdb数据库

2.1 创建一个空白数据库

例如，我们要在工作表所在目录中新建一个mdb数据库：

Sub New_Database()
Dim ObjCatalog As Object
Set ObjCatalog = CreateObject("ADOX.Catalog") '创建并实例化一个"Adox.catalog"对象，本例中，该对象仅用于新建一个数据库
MyDatabase = ThisWorkbook.Path & "\Database.mdb"

'在工作表所在目录中新建Database.mdb
If Dir(MyDatabase) = "" Then
    ObjCatalog.Create "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & MyDatabase
Else
    Exit Sub
End If
End Sub

2.2 连接至数据库

Sub Connect_Database()
Dim ObjConnection As Object
Set ObjConnection = CreateObject("Adodb.Connection") '创建实例化一个ADO Connection对象
MyDatabase = ThisWorkbook.Path & "\Database.mdb"
With ObjConnection
.Provider = "Microsoft.ACE.OLEDB.16.0"
.Open MyDatabase 
MsgBox .State
End With
End Sub

说明：Connection对象的State属性用于指示对象的状态，由以下数值组成

adStateClosed 0 对象已关闭。
adStateOpen 1 对象已打开。
adStateConnecting 2 对象正在连接。
adStateExecuting 4 对象正在执行命令。
adStateFetching 8 正在检索对象的行

2.3 创建数据库表

Sub Connect_Database()
Dim ObjConnection As Object
Set ObjConnection = CreateObject("Adodb.Connection")
MyDatabase = ThisWorkbook.Path & "\Database.mdb"
With ObjConnection
.Provider = "Microsoft.ACE.OLEDB.16.0"
.Open MyDatabase
.Execute "CREATE TABLE Results (FolderName CHAR,CreateTime CHAR,HtmlAddress CHAR,ImgNum Long,ImgDownloadNum Long,FolderPathName ChAR,LocalHtml CHAR)"
.Execute "CREATE TABLE IMGMD5 (MD5 CHAR,PicAddress CHAR, HtmlAddress CHAR, FolderName CHAR, FilePathName CHAR)"
End With
End Sub

上面的代码主要作用：

• 1、连接并打开工作表所在目录的Database.mdb数据库；

• 2、执行SQL语句

  • （1）创建名为"Results"的表，该表包含的字段（类型）分别为FolderName(字符型)、CreateTime(字符型)、HtmlAddress(字符型)、ImgNum(长整型)、ImgDownloadNum(长整型)、FolderPathName(字符型)、LocalHtml(字符型)。

  • （2）创建名为"IMGMD5"的表，该表包含的字段（类型）分别为MD5(字符型)、PicAddress(字符型)、FolderName(字符型)、FilePathName(字符型)。

数据库包含的表及其字段

2.4 数据库写入

• 1、将下载结果写入数据库

    Public Sub Write_ResultsToDatabase(FolderName As String, CreateTime As String, HtmlAddress As String, ImgNum As Long,                                   ImgDownloadNum As Long, FolderPathName As String, LocalHtml As String)
    
    Dim ObjConnection As Object
    Set ObjConnection = CreateObject("Adodb.Connection")
    Dim MyDatabase As String
    Dim SQL As String
    MyDatabase = ThisWorkbook.Path & "\Database.mdb"
    SQL = "INSERT INTO Results Values (" & Chr(39) & FolderName & Chr(39) & "," & Chr(39) & CreateTime & Chr(39) & "," & Chr(39) & HtmlAddress & Chr(39) & "," & _
          Chr(39) & ImgNum & Chr(39) & "," & Chr(39) & ImgDownloadNum & Chr(39) & "," & Chr(39) & FolderPathName & Chr(39) & "," & Chr(39) & LocalHtml & Chr(39) & " )"
    MsgBox SQL
    With IConnection
        .Provider = "Microsoft.ACE.OLEDB.16.0"
        .Open MyDatabase
        .Execute SQL
        .Close
    End With
    End Sub
  

• 2、将图片文件MD5写入数据库

    Public Sub Write_ImgMd5ToDatabase(PicMD5 As String, PicAddress As String, HtmlAddress As String, FolderName As String, FilePathName As String)
    Dim ObjConnection As Object
    Set ObjConnection = CreateObject("Adodb.Connection")
    Dim MyDatabase As String
    Dim SQL As String
    MyDatabase = ThisWorkbook.Path & "\Database.mdb"
    SQL = "INSERT INTO IMGMD5 Values (" & Chr(39) & PicMD5 & Chr(39) & "," & Chr(39) & PicAddress & Chr(39) & "," & Chr(39) & HtmlAddress & Chr(39) & "," & _
          Chr(39) & FolderName & Chr(39) & "," & Chr(39) & FilePathName & Chr(39) & " )"
    'MsgBox SQL
    With IConnection
        .Provider = "Microsoft.ACE.OLEDB.16.0"
        .Open MyDatabase
        .Execute SQL
        .Close
    End With
    End Sub
  

2.5 查询操作

当我们在下载图片时，比较图片的MD5查询数据库中是否存在相同的值，如果有，则说明图片已被下载。这个过程中，我们就使用了数据库的查询操作，查询操作是通过Ado的Recordset对象来实现。

例如，我们在下载图片过程中，获得了图片的MD5值（假设为"e9c860bf4ec4b24f065155b7bd130920 "），然后我们连接至数据库进行查询：

Sub Inquire()
Dim IConnection As Object
Dim IRecordset As Object
Dim SQL As String
Set IConnection = CreateObject("adodb.connection")
Set IRecordset = CreateObject("adodb.recordset") '初始化一个Recordset对象

MyDatabase = ThisWorkbook.Path & "\Database.mdb" 
SQL = "select * from IMGMD5 where MD5 = " & Chr(39) & "e9c860bf4ec4b24f065155b7bd130920" & Chr(39)  'SQL查询语句，意思是在打开的数据库的IMGMD5工作表中，查询是否有MD5=e9c860bf4ec4b24f065155b7bd130920的值
With IConnection
.Provider = "Microsoft.ACE.OLEDB.16.0"
.Open MyDatabase
End With
IRecordset.Open SQL, IConnection, 1, 1
If IRecordset.RecordCount = 0 Then
    MsgBox "数据库中不存在"
Else
    MsgBox "数据库中有" & IRecordset.RecordCount & "个"
End If
End Sub

运行结果返回值为1，说明数据库存在MD5=e9c860bf4ec4b24f065155b7bd130920的数据，且数量为1。

关于ADO对象和方法在这里不是重点内容，不做具体介绍，如有兴趣请访问 ADO 教程。