前言:
目前看官们对“用vbs把内容写入excel”可能比较关注,小伙伴们都需要分析一些“用vbs把内容写入excel”的相关文章。那么小编也在网摘上收集了一些有关“用vbs把内容写入excel””的相关知识,希望我们能喜欢,我们一起来学习一下吧!思路与之前发送信息一样,将“文件”放入剪贴板中,就可以用CTRL+V,粘贴到微信信息框中实现发送文件了。
可是VBA 自带函数FileCopy 并不产生文件复制到剪贴板的效果,需调用Window API接口操作,代码如下。(来自EXCEL HOME论坛)
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatW" (ByVal lpString As LongPtr) As LongPrivate Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPrivate Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPrivate Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPrivate Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPrivate Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtrPrivate Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPrivate Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal flags As Long, ByVal Size As Long) As LongPtrPrivate Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal hpvDest As LongPtr, ByVal hpvSource As LongPtr, ByVal cbCopy As Long)' API函数定义结束Private Const CF_HDROP As Long = 15&Private Const DROPEFFECT_COPY As Long = 1Private Const DROPEFFECT_MOVE As Long = 2Private Const GMEM_ZEROINIT As Long = &H40Private Const GMEM_MOVEABLE As Long = &H2Private Const GMEM_DDESHARE As Long = &H2000' 结构定义开始Private Type POINTAPI X As Long Y As LongEnd TypePrivate Type dropFiles pFiles As Long pt As POINTAPI fNC As Long fWide As LongEnd Type' 结构定义结束Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
上面的代码都是 API函数的定义所需的(64位的VBE环境)。下面代码是将文件复制到剪贴板。
Sub clipCopyFile(FileList As Variant) Dim uDropEffect As Long, I As Long Dim dropFiles As dropFiles Dim uGblLen As Long, uDropFilesLen As Long Dim hGblFiles As LongPtr Dim hGblEffect As LongPtr Dim mPtr As LongPtr Dim FName As String If OpenClipboard(0) Then EmptyClipboard FName = Trim(FileList) If Len(FName) Then uDropEffect = RegisterClipboardFormat(StrPtr("Preferred DropEffect")) hGblEffect = GlobalAlloc(GMEM_ZEROINIT Or GMEM_MOVEABLE Or GMEM_DDESHARE, Len(uDropEffect)) mPtr = GlobalLock(hGblEffect) I = DROPEFFECT_COPY CopyMemory mPtr, VarPtr(I), Len(I) GlobalUnlock hGblEffect SetClipboardData uDropEffect, hGblEffect uDropFilesLen = LenB(dropFiles) With dropFiles .pFiles = uDropFilesLen .fWide = CLng(True) End With uGblLen = uDropFilesLen + LenB(FName) + 8 hGblFiles = GlobalAlloc(GMEM_ZEROINIT Or GMEM_MOVEABLE Or GMEM_DDESHARE, uGblLen) mPtr = GlobalLock(hGblFiles) CopyMemory mPtr, VarPtr(dropFiles), uDropFilesLen mPtr = mPtr + uDropFilesLen hGblEffect = StrPtr(FName) I = LenB(FName) CopyMemory mPtr, hGblEffect, I GlobalUnlock hGblFiles SetClipboardData CF_HDROP, hGblFiles End If CloseClipboard End If End Sub
此clipCopyFile过程只处理单个的文件(已被我修改了),需要一次处理多个文件的,可去EXCEL HOME论坛查看源码。
微信发文件代码:
Sub 发文件() Set ws = CreateObject("wscript.shell") ws.SendKeys "^%w"For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row ws.Run "mshta vbscript:ClipboardData.SetData(""Text""," & Chr(34) & Cells(I, 1) & Chr(34) & ")(close)", 0, True Sleep 300 ws.SendKeys "^f" Sleep 1000 ws.SendKeys "^v" Sleep 500 ws.SendKeys "{ENTER}" Sleep 500 ws.Run "mshta vbscript:ClipboardData.SetData(" & Chr(34) & "Text" & Chr(34) & "," & Chr(34) & Cells(I, 2) & Chr(34) & ")(close)", 0, True Sleep 500 ws.SendKeys "^v" Sleep 500 ws.SendKeys "{ENTER}" wjName = Cells(I, 3).Value clipCopyFile wjName ws.SendKeys "^v" Sleep 500 ws.SendKeys "{ENTER}"Next I Set ws = NothingEnd Sub
版权声明:
本站文章均来自互联网搜集,如有侵犯您的权益,请联系我们删除,谢谢。
标签: #用vbs把内容写入excel