A. vb中如何查看整個文件夾地大小
Public Function GetFolderSize(Folder As String) As Long
'取得文件夾的大小，包含子目錄
On Error GoTo er
Dim Tmp As String
Dim TotalSize As Long
Dim FolderBuff() As String
Dim FolderMax As Long
Dim BuffMax As Long
cur_Folder = IIf(Right(Folder, 1) = "\", Folder, Folder & "\")
Tmp = Dir(cur_Folder & "*.*", vbDirectory)
Do Until Tmp = ""
If Tmp <> "." And Tmp <> ".." Then
If VBA.GetAttr(cur_Folder & Tmp) = vbDirectory Then '目錄
FolderMax = FolderMax + 1
If FolderMax >= BuffMax Then
BuffMax = BuffMax + 1000
ReDim Preserve FolderBuff(BuffMax)
End If
FolderBuff(FolderMax) = cur_Folder & Tmp
Else
TotalSize = TotalSize + FileLen(cur_Folder & Tmp)
End If
End If
Tmp = Dir()
Loop
For i = 1 To FolderMax
TotalSize = TotalSize + GetFolderSize(FolderBuff(i)) '遞歸目錄
Next i
er:
GetFolderSize = TotalSize
Erase FolderBuff
End Function
Private Sub Command1_Click()
'調試部分，供參考
Dim Folder As String
Folder = VBA.Environ("windir")
foldersize = GetFolderSize(Folder)
If foldersize > 1000000000 Then
Tmp = Format(foldersize / 1000000000, "0.00") & " G"
ElseIf foldersize > 1000000 Then
Tmp = Format(foldersize / 1000000, "0.0") & " M"
ElseIf foldersize > 1000 Then
Tmp = Format(foldersize / 1000, "0.0") & " k"
Else
Tmp = Format(foldersize)
End If
MsgBox "文件夾：" & Folder & vbCrLf & "大小：" & Tmp, vbInformation
End Sub
B. 怎麼用VB給文件夾加密
1、由於採用二進制讀取文件的方式，因此加密時一般可以不考慮文件類型。
2、這里只進行一次異或運算，如有需要可以進行多次異或運算。
3、此加密演算法速度快，當然加密強度也低 ；
參考代碼如下：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
'-----------------------------------------------------------------------
'函數說明： 使用異或運算加密文件（可加密大部分文件）
'參數說明： key - 密鑰
' fileName - 普通文件名，
' encryptFileName - 加密後的文件名
'返回值： true - 成功，false - 失敗
'-----------------------------------------------------------------------
Private Function XOR_Encrypt(key As Integer, fileName As String, encryptFileName As String) As Boolean
On Error GoTo errHandler
Dim inputFileNo As Integer
Dim fileBytes() As Byte
Dim length As Long
XOR_Encrypt = False
'打開文件並保存在二進制數組中
inputFileNo = FreeFile
Open fileName For Binary As #inputFileNo
length = LOF(inputFileNo)
If length = 0 Then
MsgBox "退出加密：文件內容為空！", vbInformation, "提示"
Exit Function
End If
ReDim fileBytes(length - 1) As Byte
Get inputFileNo, , fileBytes()
Close #inputFileNo
'將該二進制數組進行異或加密
Dim i As Long
For i = LBound(fileBytes) To UBound(fileBytes)
fileBytes(i) = fileBytes(i) Xor key
Next
'將異或加密後的二進制數組保存在新的文件中
Dim outputFileNo As Integer
outputFileNo = FreeFile
Open encryptFileName For Binary As #outputFileNo
Put outputFileNo, , fileBytes
Close #outputFileNo
XOR_Encrypt = True
errHandler:
If Err.Number Then
MsgBox "加密過程中出錯：" & Err.Description, vbCritical, "錯誤"
XOR_Encrypt = False
Resume Next
End If
End Function