|
[x]
Posted via EE Mobile
|
||
Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again. |
||
| Question |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
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: |
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, "\", -1, vbTextCompare)
sFileName = Right(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
|
Advertisement
| Hall of Fame |