|
[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: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: |
Sub saveXLAttachments(mai As MailItem)
Dim dosFolderPath As String
Dim tmpFolderPath As String
Dim intIncrement As Integer
Dim intAtt As Integer
Dim att As Attachment
Dim fn As String
Dim ft As String
Dim fso As Object
dosFolderPath = "c:\deleteme"
If Right(dosFolderPath, 1) <> "\" Then dosFolderPath = dosFolderPath & "\"
Set fso = CreateObject("scripting.filesystemobject")
For intAtt = mai.Attachments.Count To 1 Step -1
Set att = mai.Attachments(intAtt)
intIncrement = 1
fn = Left(att.FileName, InStrRev(att.FileName, ".") - 1)
ft = Right(att.FileName, Len(att.FileName) - InStrRev(att.FileName, ".") + 1)
If LCase(ft) = ".xls" Then
If Len(fn) > 6 Then
If IsNumeric(Right(fn, 6)) Then
If CInt(Right(fn, 2)) > 0 And CInt(Right(fn, 2)) <= 12 Then
tmpFolderPath = dosFolderPath & MonthName(CInt(Right(fn, 2))) & " " & Left(Right(fn, 6), 4) & "\"
md tmpFolderPath, True
Do While fso.FileExists(tmpFolderPath & fn & "_" & intIncrement & ft)
intIncrement = intIncrement + 1
Loop
att.SaveAsFile tmpFolderPath & fn & "_" & intIncrement & ft
End If
End If
End If
End If
Next
Set fso = Nothing
End Sub
Function md(dosPath As String, Optional createFolders As Boolean) As String
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
Dim bolret As Boolean
md = ""
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(dosPath) Then
fldrs = Split(dosPath, "\")
rootdir = fldrs(0)
If Not fso.FolderExists(rootdir) Then
Exit Function
End If
bolret = True
For fldrIndex = 1 To UBound(fldrs) - 1
rootdir = rootdir & "\" & fldrs(fldrIndex)
If Not fso.FolderExists(rootdir) Then
If createFolders Then
fso.CreateFolder rootdir
Else
bolret = False
End If
End If
Next
If bolret Then
For Each fldr In fso.getfolder(rootdir).SubFolders
If Left(fldr.Name, 2) = fldrs(UBound(fldrs)) Then
md = fldr.Path
Exit Function
End If
Next
End If
Exit Function
End If
End Function
|
Advertisement
| Hall of Fame |