我发现这种方法非常方便，可以嵌入/定义大型VBA字符串，将整个文本文件嵌入到字符串变量中进行读取，或者重新创建嵌入的二进制文件，所有这些都可以通过模块顶部的注释来完成。
首先，使用以下VBS脚本从文件（文本或二进制）创建压缩的、Base64编码的、每行255个字符宽的注释行：
Dim wsh, fso
Set wsh = wscript.CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.fileSystemObject")
On Error Resume Next
'DROP-IN HANDLER
'***************
If WScript.Arguments.Count > 0 Then
For each arg in WScript.Arguments
path_and_filename = path_and_filename & arg
Next
tokens = Split(path_and_filename, "\")
infilename = tokens(UBound(tokens))
For i=0 To UBound(tokens)-1
path = path & tokens(i) & "\"
Next
else
wsh.Popup "No drop-in file!" & vbcrlf & vbcrlf & "Drag the icon of the file you want to compress and convert to VBA comment format" & vbcrlf & "and drop it into the Bin2VBAComment.vbs icon.", 0, "Error!", 4096+16
wscript.quit
End If
outfilename = infilename & "-Comment.txt"
tempfile = fso.GetTempName
'MAKECAB NEEDS THE TRAILING "\" REMOVED FROM THE PATH TO COMPRESS THE FILE
'*************************************************************************
wsh.run ("cmd /c makecab /L """ & left(path,len(path)-1) & """ """ & WScript.Arguments(0) & """ " & tempfile ),0,True
'BASE64 ENCODE THE COMPRESSED CAB FILE
'*************************************
bytes_ = readBytes(path & tempfile)
base64_ = encodeBase64(bytes_)
'REMOVE THE LINE FEEDS AT CHARACTER 72...
'****************************************
base64_ = replace(base64_,vblf,"")
'...SO WE CAN PUT THEM AFTER CHARACTER 255
'*****************************************
x=1
linecount_=0
do while x<len(base64_)
out_ = out_ & "'" & Mid(base64_,x,255) & vbcrlf
x=x+255
linecount_=linecount_+1
loop
'CREATE THE TEXT FILE
'********************
set objOutputFile = fso.CreateTextFile(path & outfilename, TRUE)
objOutputFile.WriteLine("'" & infilename)
objOutputFile.WriteLine("'" & linecount_)
objOutputFile.Write(out_)
objOutputFile.Close
'TIDY-UP
'*******
if fso.FileExists(path & tempfile) then
Set aFile = fso.GetFile(path & tempfile)
aFile.Delete
end if
wsh.Popup "Done!", 2, "Bin2VBAComment.vbs", 4096+48
private function readBytes(file)
dim inStream
set inStream = WScript.CreateObject("ADODB.Stream")
inStream.Open
inStream.type= 1 'TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
end function
private function encodeBase64(bytes)
dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
Set EL = DM.createElement("tmp")
EL.DataType = "bin.base64"
EL.NodeTypedValue = bytes
encodeBase64 = EL.Text
end function
作为一个例子，我插入了一个二维码图片，创建了"QR.png-Comment.txt"文件。
'QR.png
'3
'TVNDRgAAAAA0AgAAAAAAACwAAAAAAAAAAwEBAAEAAAAAAAAAQwAAAAEAAQDoAQAAAAAAAAAAGVdVjCAAUVIucG5nAJuWuhbpAegBQ0vrDPBz5+WS4mJgYOD19HAJYmBgnADCjMxAkV2FS/qBFGNxkLsTw7pzMi+BHJZ0R19HBoaN/dx/ElmBfLYAnxBXIP3///+lN+ffBbI4CzwiixkY+A6DMOPx/BUpQCOyPV0cQypuvb0Z2HVEgachUZH99VX
'biINH3ZJjyreF/jb60J6Ykb2vkutkhvMsPg4WpkYHBYET2ydJZJ0o1X760FDHUaF7yZ048fRzZwpjS7wFTrB1hj90LVwlFN3kEKeoG9ymyvHENchdi+WT2EdxVXWbeScETuhymi4x2futEKja6GPgrvsvL9c4KGgfqZq79Om+5yEiHCndL5x1Tyw4WaUrf1ybxch1C8dWvv6opSu3HQzaCLTg48WtBy/IPnRSsD7y/MiF+RURxi0OZR0l7Zm/sh
'w8/8txMUUq/it4LHHP9mcjd+OaiWa2568xTK7nN+0L50hpi/C99U7B6/HBfyccFVYfaVe97fH3izgfU6VfTr9ATO2/WTsFTohNDJu8MTxs2uOKVodlHiWmlTtsm47NT+UEmiXz9Y6zOfctoeAmh3uK0zLf6nn9bnOY5pm+VkHeL4XjybQrhlJZkc/kX/Zf/3c70kGhPEVNQQASZvFuQb8YuQNVPbev2/YAGBcMnq5+LuucEpoA
将此文本粘贴到模块的顶部（例如Module1）。
在"ThisWorkbook"宏的顶部，创建一个全局变量用于文件名，以便在Workbook_BeforeClose时进行删除。
Public BinFilename As String
然后添加以下宏：
Private Sub Workbook_Open()
Set wsh = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
'ACTIVATE THE MODULE CONTAINING THE COMPRESSED TEXT AT THE TOP
ThisWorkbook.VBProject.VBComponents("Module1").Activate
'GET THE FILE NAME FROM THE FIRST LINE
filename_ = Replace(Application.VBE.ActiveCodePane.CodeModule.Lines(1, 1), "'", "")
'SET THE GLOBAL VARIABLE SO WE CAN DELETE THE FILE ON CLOSE
BinFilename = filename_
'GET THE NUMBER OF LINES FROM THE SECOND LINE
no_of_lines_ = Replace(Application.VBE.ActiveCodePane.CodeModule.Lines(2, 1), "'", "")
'GET THE BASE64 TEXT FROM LINE 3 ONWARDS, REMOVING COMMENT TICKS, CARRIAGE RETURNS AND SPACES
base64_ = Replace(Application.VBE.ActiveCodePane.CodeModule.Lines(3, no_of_lines_), "'", "")
base64_ = Replace(base64_, vbCrLf, "")
base64_ = Replace(base64_, " ", "")
'GET THE LOCAL TEMP DIRECTORY AND A TEMP FILE NAME
tempFolderPath = fso.GetSpecialFolder(2)
tempfilename = tempFolderPath & "\" & fso.GetTempName
'CONVERT THE BASE64 TEXT TO POPULATE THE TEMP COMPRESSED FILE
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
Set EL = DM.createElement("tmp")
EL.DataType = "bin.base64"
EL.Text = base64_
Dim binaryStream
Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = 1 'adTypeBinary
binaryStream.Open
binaryStream.Write EL.NodeTypedValue
binaryStream.SaveToFile tempfilename, 2
'DECOMPRESS THE TEMP FILE TO RECREATE THE ORIGINAL FILE
wsh.Run ("cmd /c expand -F:* """ & tempfilename & """ """ & tempFolderPath & "\" & filename_ & """"), 0, True
'DELETE THE TEMP FILE
fso.DeleteFile (tempfilename)
'DECIDE WHAT TO DO WITH THE FILE
If LCase(Right(filename_, 3)) = "txt" Then
'LOAD THE TEXT FILE CONTENTS INTO A VARIABLE
LoadFileStr = fso.OpenTextFile(tempFolderPath & "\" & filename_, 1).readall
MsgBox LoadFileStr
Else
'ASSUME IT'S A BINARY FILE AND RUN IT
wsh.Run ("cmd /c " & Chr(34) & tempFolderPath & "\" & filename_ & Chr(34)), 0, False
End If
End Sub
并且
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'DELETE THE CREATED FILE ON EXIT
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile (fso.GetSpecialFolder(2) & "\" & BinFilename)
End Sub
Workbook_Open宏查看Module1注释，从第一行提取原始文件名并将其传递给"BinFilename"以进行删除。然后从第2行获取行数，并从第3行开始获取Base64文本。
Base64文本被解码，使用Microsoft Expand函数进行解压缩，然后在临时目录中创建文件。
读取一个.txt文件，并将其内容传递给"LoadFileStr"变量。任何其他文件类型都将作为二进制文件运行。
Workbook_BeforeClose在关闭时从临时目录中删除该文件。
Dim s as String, 然后赋值为s = String(1337, "a")。 - user2140173