保存Excel工作簿中所有的嵌入文件

概述保存Excel工作簿中所有的嵌入文件

下面是内存溢出 jb51.cc 通过网络收集整理的代码片段。

内存溢出小编现在分享给大家，也给大家做个参考。

Function SaveEmbeddedfiles(fname)    Dim wkB As Workbook    Dim wksLog As Worksheet    Dim wksDetail As Worksheet    Dim sArchivePath As String    Dim sFullfilename As String    Dim sfilename As String    Dim iPos As Integer    Dim oolE As olEObject    Dim wordDoc     sArchivePath = "R:\Enabling_Applications\GSM7_RF\Request Catalogue\WFD Form Returns\file Attachments\"    pArchivePath = "R:\Enabling_Applications\GSM7_RF\Request Catalogue\WFD Form Returns\Image Attachments\"    Set wkB = Workbooks(fname)    Set wksLog = wkB.Worksheets("Attachments")    Set wksDetail = wkB.Worksheets("WorksheetF")    iLast = Worksheets("WorksheetF").Range("C2").End(xlDown).Row    For iCnt = 2 To iLast    Range("C" & iCnt).Value = Replace(Range("C" & iCnt).Value,"file Attachement - C","C")    Range("C" & iCnt).Value = Replace(Range("C" & iCnt).Value,"Image Attachement - C","C")    For Each oolE In wksLog.olEObjects        DeBUG.Print oolE.progID        If Not LCase(oolE.progID) = "package" Then            sFullfilename = wksDetail.Range("C" & iCnt).Value            iPos = InStrRev(sFullfilename,"\",-1,vbTextCompare)            sfilename = Right(sFullfilename,Len(sFullfilename) - iPos)            oolE.Activate            Set wordDoc = oolE.Object                wordDoc.SaveAs sArchivePath & sfilename                wordDoc.Close        ElseIf LCase(oolE.progID) = "package" Then            sFullfilename = wksDetail.Range("C" & iCnt).Value            iPos = InStrRev(sFullfilename,Len(sFullfilename) - iPos)            oolE.Verb xlVerbOpen            SendKeys "%FS",True            SendKeys pArchivePath & sfilename,True            SendKeys "%s",True            SendKeys "%Fx",True        End If    Next oolE    Next    End Function

以上是内存溢出(jb51.cc)为你收集整理的全部代码内容，希望文章能够帮你解决所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。

总结

以上是内存溢出为你收集整理的保存Excel工作簿中所有的嵌入文件全部内容，希望文章能够帮你解决保存Excel工作簿中所有的嵌入文件所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。