vba里使用.net类

fxl447098457

分享一个自己保存的经典模块。今天整理下资料给vber/vbaer瞧上一瞧。附件示例通过引用common language runtime execution engine 和mscorlib.dll以及相关类模块打通vba和.net壁垒.手段也比曾经我通过powershell去调用.net里的类要优雅得多。我相信会为vber/vbaer打开一扇新的大门。附件里展示了一个vba里使用c#的正则demo。wps(x86)/office 365(x64)测试均通过。
vba使用.net.xlsm.7z (70.98 KB, 下载次数: 36)

2024-5-13 13:18 上传

点击文件名下载附件

perfect131

感谢分享 那这个怎么不用 powershell 写这个
https://club.excelhome.net/forum ... 35&pid=11492448

fxl447098457

因为这个源码是通过反射实现的,这就和com里的后期绑定那样,没那么友好。其实你上面的帖子里代码我转换到这个里面也一样可以实现,顺便打印了一下图片的宽高度。代码如下：
Sub test1()
    Dim host As New CLRHost, inputFile$, outputFile$
    Call host.Initialize(False)
    inputFile = ThisWorkbook.Path & "\1.emf"
    outputFile = ThisWorkbook.Path & "\1.png"
    On Error Resume Next
    Dim asmSys As mscorlib.Assembly
   Set asmSys = host.CLRLoadAssembly("System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
   Dim imgclass As mscorlib.Object, img As mscorlib.Object, fmt As mscorlib.Object, png As mscorlib.Object
   Set imgclass = host.CLRResolveType("System.Drawing.Image")
   Set img = host.CLRInvokeStaticMethod(imgclass, "FromFile", inputFile)
    Debug.Print "图片高度: "; host.CLRProperty(img, "Height"); "图片宽度:"; host.CLRProperty(img, "Width")
   Set fmt = host.CLRResolveType("System.Drawing.Imaging.ImageFormat")
   Set png = host.CLRInvokeMethod(host.CLRInvokeMethod(fmt, "GetProperty", "Png"), "GetValue", Null)
   host.CLRInvokeMethod img, "Save", outputFile, png
   Set imgclass = Nothing
   Set img = Nothing
   Set fmt = Nothing
   Set png = Nothing
   Set host = Nothing
End Sub

fxl447098457

Sub 获取压缩包列表()
'这个例子至少需要.net 4.5才能支持
'System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089
Dim host As New CLRHost, zipfilepath As String
Call host.Initialize(False)
'On Error Resume Next
Dim asmSys As mscorlib.Assembly, ZipFile As mscorlib.Object, archive As mscorlib.Object, Entries As Variant, entry As Variant
Set asmSys = host.CLRLoadAssembly("System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
Set ZipFile = host.CLRResolveType("System.IO.Compression.ZipFile")
zipfilepath = "C:\Users\Administrator\Downloads\Compressed\pcre2-10.43.zip"
If Len(Dir(zipfilepath)) = 0 Then MsgBox "所在路径的zip压缩包不存在": Exit Sub
Set archive = host.CLRInvokeStaticMethod(ZipFile, "OpenRead", "C:\Users\Administrator\Downloads\Compressed\pcre2-10.43.zip")
Set Entries = host.ToEnumerable(host.CLRProperty(archive, "Entries"))
For Each entry In Entries
    Debug.Print host.CLRProperty(entry, "FullName")
Next
    Set archive = Nothing
    Set ZipFile = Nothing
    Set host = Nothing
End Sub

fxl447098457

Sub 使用随机数()
Dim host As New CLRHost, dic As Object, s As Long, key As Variant
Dim objRandom As mscorlib.Object, asmSys As mscorlib.Assembly
Call host.Initialize(False)
Set dic = CreateObject("scripting.dictionary")
Set asmSys = host.CLRLoadAssembly("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    Set objRandom = host.CLRCreateObject("System.Random")
    ' 使用「System.Random.Next(Int32, Int32)」
    '生成十个不重复随机数
    Do
        s = host.CLRInvokeMethod(objRandom, "Next")
        If Not dic.Exists(s) Then dic.Add s, ""
    Loop Until dic.Count >= 10
    For Each key In dic.Keys
        Debug.Print key
    Next key
    Set dic = Nothing
    Set objRandom = Nothing
    Set host = Nothing
End Sub

fxl447098457

Sub filetext() '写入文本
Dim host As New CLRHost, Encoding As mscorlib.Object, utf8 As mscorlib.Object, textPath$, createText$
Call host.Initialize(False)
'On Error Resume Next
Dim asmSys As mscorlib.Assembly, SW As mscorlib.Object, writer As mscorlib.Object
host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
host.CLRLoadAssembly ("System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
host.CLRLoadAssembly ("System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")

Set SW = host.CLRResolveType("System.IO.Stream")
Set Encoding = host.CLRResolveType("System.Text.Encoding")
Set utf8 = host.CLRInvokeMethod(host.CLRInvokeMethod(Encoding, "GetProperty", "UTF8"), "GetValue", Null)
textPath = ThisWorkbook.Path & "\CDriveDirs.txt"
Set writer = host.ToObject(host.CLRGetType(SW).Assembly).CreateInstance_3("System.IO.StreamWriter", False, BindingFlags_Instance Or BindingFlags_Public Or BindingFlags_CreateInstance, Nothing, Array(textPath, False, utf8), Nothing, Array())
createText = "Hello and Welcome,热烈欢迎"
host.CLRInvokeMethod writer, "Write", createText  '此excel所在路径文件夹会生成一个CDriveDirs.txt，并写入utf8文本with BOM
host.CLRInvokeMethod writer, "Close"
Set SW = Nothing
Set writer = Nothing
Set Encoding = Nothing
Set utf8 = Nothing
Set host = Nothing
End Sub

fxl447098457

Sub filetextReader() '读入文本
Dim host As New CLRHost, Encoding As mscorlib.Object, utf8 As mscorlib.Object, textPath$, readText$
Call host.Initialize(False)
'On Error Resume Next
Dim asmSys As mscorlib.Assembly, SW As mscorlib.Object, reader As mscorlib.Object
host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
host.CLRLoadAssembly ("System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
host.CLRLoadAssembly ("System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
textPath = ThisWorkbook.Path & "\CDriveDirs.txt"
If Len(Dir(textPath)) = 0 Then MsgBox "先执行上面的写入文本操作再来读取文本.": GoTo label:
Set SW = host.CLRResolveType("System.IO.Stream")
Set Encoding = host.CLRResolveType("System.Text.Encoding")
Set utf8 = host.CLRInvokeMethod(host.CLRInvokeMethod(Encoding, "GetProperty", "UTF8"), "GetValue", Null)
Set reader = host.ToObject(host.CLRGetType(SW).Assembly).CreateInstance_3("System.IO.StreamReader", False, BindingFlags_Public Or BindingFlags_Instance Or BindingFlags_CreateInstance, Nothing, Array(textPath, utf8), Nothing, Array())
readText = host.CLRInvokeMethod(reader, "ReadToEnd")
host.CLRInvokeMethod reader, "Close"
Debug.Print readText
label:
Set SW = Nothing
Set reader = Nothing
Set Encoding = Nothing
Set utf8 = Nothing
Set host = Nothing
End Sub

fxl447098457

'.net version 3.5 not necessary
Sub ssortedlist()
Dim host As New CLRHost
Call host.Initialize(False)
Dim Assem As mscorlib.Assembly, mySL As Object, Total%, i%, aList As Object, interfacelist As Object
host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
Set Assem = host.CLRLoadAssembly("System.Collections, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
Set mySL = host.ToObject(host.CLRCreateObject("System.Collections.SortedList"))
mySL.Add "Third", "!"
mySL.Add "Second", "World"
mySL.Add "First", "Hello"
Total = mySL.Count
Debug.Print "个数：", Total
For i = 0 To Total - 1
Debug.Print mySL.GetKey(i), mySL.GetByIndex(i)
Next

Set mySL = Nothing
Stop
Set aList = host.ToObject(host.CLRCreateObject("System.Collections.ArrayList"))
aList.Add ("Hello")
aList.Add ("World")
aList.Add ("!")
For Each key In aList
Debug.Print key
Next key
Debug.Print aList.IndexOf("!", 0)
Set aList = Nothing
Set host = Nothing
End Sub

fxl447098457

Sub stringbuildtest()
'.net version 3.5 not necessary
Dim host As New CLRHost
Call host.Initialize(False)
Dim Assem As mscorlib.Assembly, sb As mscorlib.Object, r As Variant
host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
Set sb = host.ToObject(host.CLRCreateObject("System.Text.StringBuilder"))
   Set sb = host.CLRInvokeMethod(sb, "Append", "The quick brown fox jumped over the lazy dog. ")
   Set sb = host.CLRInvokeMethod(sb, "Append", "Mary had a little lamb.")
   Debug.Print host.CLRProperty(sb, "Length")
    r = host.CLRInvokeMethod(sb, "ToString")
    Debug.Print r
    Set sb = Nothing
     Set host = Nothing
End Sub