PDA

View Full Version : [SOLVED:] Saving attachment with subject - help to change file type in the coding



leemcder
08-07-2020, 06:18 AM
Hi guys, hoping someone can help me with this. I've got this code which saves .xls attachments from my outlook folder and renames with part of the subject. I now want this to do exactly the same but for word documents. The documents are .DOC so I assumed I could just amend the code and replace .xls with .DOC but it nothing saves when I'm using .DOC

I'd appreciate any help

Thanks


Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim strSubject As String
Dim strName As String
strSubject = "Our Ref: " & Right(itm.Subject, Len(itm.Subject) - InStrRev(itm.Subject, Chr(32)))
saveFolder = "Y:\accounts\success fee bills\"
For Each objAtt In itm.Attachments
If Right(LCase(objAtt.fileName), 4) = ".xls" Then
strName = CleanFileName(strSubject & ".xls", ".xls")
objAtt.SaveAsFile saveFolder & strName
End If
Next objAtt
Set objAtt = Nothing
End Sub

Public Function CleanFileName(strFilename As String, strExtension As String) As String
'Graham Mayor
'A function to ensure there are no illegal filename
'characters in a string to be used as a filename
'strFilename is the filename to check
'strExtension is the extension of the file
Dim arrInvalid() As String
Dim vfName As Variant
Dim lng_Name As Long
Dim lng_Ext As Long
Dim lngIndex As Long
'Ensure there is no period included with the extension
strExtension = Replace(strExtension, Chr(46), "")
'Record the length of the extension
lng_Ext = Len(strExtension)
'Remove the path from the filename if present
If InStr(1, strFilename, Chr(92)) > 0 Then
vfName = Split(strFilename, Chr(92))
CleanFileName = vfName(UBound(vfName))
Else
CleanFileName = strFilename
End If
'Remove the extension from the filename if present
If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
End If

'Define illegal characters (by ASCII CharNum)
arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
'Add the extension to the filename
CleanFileName = CleanFileName & Chr(46) & strExtension
'Remove any illegal filename characters
For lngIndex = 0 To UBound(arrInvalid)
CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
Next lngIndex
lbl_Exit:
Exit Function
End Function

gmayor
08-07-2020, 06:50 AM
You could replace ".xls" with ".doc" or with "docx" if the current format (not ".DOC")

leemcder
08-07-2020, 07:04 AM
Thanks for the reply. I have tried this and its not working. It works fine when the file type is .xls but when I try it with a word (.doc) file and I've also changed to .docx and none of this works. These are a screen shot of the email attachment and its definitely a .doc file so can't figure out why it works for when its .xls but not .doc

http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAnUAAABJCAYAAABb0NCrAAAAAXNSR0IArs4c6QAA AARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAjCSURBVHhe7d1PbBzVHcDxny2 XQyUIkoVR20PghJIgDggiRPijIJxYqOKAlJYDrUqkNgghIU5Rjj1FObRRT5BLDiSIQySqXtqI2H Ft1IsFFxCpgEOVtm6D0kgB20Jy/Kfzm52feX6aNzszO7ueff5 4ped9 a937x5O7v5MZssI5sJAQAAwFAbzR4BAAAwxEjqAAAAIkBSBwAAEAGSOgAAgAiQ1AEAAESApA4AA CACJHUAAAARIKkDAACIAEkdAABABEjqAAAAIkBSBwAAEAGSOgAAgAiQ1AEAAESApA4AACACJHUA AAARIKkDAACIAEkdAABABEjqAAAAIkBSBwAAEIGRxcXFzWwbAAAAQ2pkM5FtAwAAYEjx8SsAAEA ESOoAAAAiQFIHAAAQAZI6AACACJDUAQAARICkDgAAIAK1vtJkbm4u2wpbX1 XtbU1OXLkSNYCAO1w8d2L2Va H9w1Js9PTsr4 HjWAgDtVzupe rQoWR08jOS/Jawx42NDRkdHZWPP/5Ebt68KWNjYyR2AFpFk7pXfvlKVtvuD2fPyq9efVUuX75MYgdgqNT6 FXzQP2V/mQ5oT1qQqfu3Lkjhw8fTu/YTU9Pp20AMAz23HuvTE1NyfSVK3Lr1q2sFQDarVZSp3fjihI7tbKyIvPz82mS57YDQJstLCykjy R2AIZNrY9fZ2Zm5Jmnn9LPXOXzz6/Jnj17dDP17bdLMnH/hNw/MSE3/ntDVldX5cuvvpLJyclOB499bKtsKtqWt11Hr MHrep8e10rHeNyY7n8uN32G39 Kq v20 ViZ83RuuhsX5/7C77jr2TbRV77cnv5M233spqIt/cvp1 FPvzl1/OWqpdS6HrtBdNXsturF7jNjmvkF6O0Y/5aUylcQe5fv04l17YOpjQ3Nx vfZx99kYv7/fz5UXQ sWy1ifolhtUSupu5L8l uzzzydnuA///VveWDvXhkZHUnr169flxs3vpYHH3xAJpLETn344RU5evRouu0KLVCTCzcMT4Kr6nx7PT9/vNVD7abMcd0 RdsmFN/6uPtVUcyiWH4c7A6a1P390mtZLZ/2eXRs z8EO3jwoIyP37ft7 BVuY6Krse6mryO2xorZBDHKKvpuVSJ16Z1UP588uZXp0 e0Dhl7VZXoXhunNC2KtrXNr19/JqUjY112dhM6hudk9ybJHj79 1L79gVKbsw2s l9bw2e3T3hdqNtZfdV7ZNFdVt2x8Xand122dsu6h/Ffpc9RIn9FzbdeTS47htobHG7w EaNJmZfHm0rZHLeq999/fVty7dt34rzfbtna/bvy6cvu63HZ3n9XdtjxF/fy2vH5W9/eF2l15 7qNs/a8fapov9 et 33MdZetN8e3W2Tt99Ym99eJDQmFKdbu7/f75tX99uK6HuyH99/ny7Tp4xQ7LKx6h63jWoldfqPH/T8dRE620kleV5 M/Nr fR/n8nd99y9lfhZ/ybYwmtxLwSVt8 Ob 0 a9fixnNjaSnb5sboxh1r43TbHm3b5Y4pI 8YTdKYVnaKnaPPnVvZ9UL83Dt1F/78afo4s/CP9PHd376YPqpz585tlbLsWnNfb3btWbtfV3njTN71a3Ubo9wYWvw4xu9XxO3rx8vbZ/Gs3Vc1nnLbtfj8/aGxIW6f0NjQeGsv6hOKb21 e0hoPqH4Zdq1lBWK1wY2t7pC47XdSi/xB63nO3Xra tJPjcij/3pSfnjf/4iP51 KWnXPkkil/XR/k2xRfbVXfRQvH6rM18dU2WuZY9ha6Clyry0r5Wyqh6jLnduVdYMu8cHV7/oPM52Hh/f/ P0UZ04cWKrVGGvo6pC4wbxWinS9LwGeZ5lXvv9Xt i KG1qKLf8V1Nx2uCzqdfz6HGtdK28y5SO6lLzlR/tr5keOHFv8mhh6fk0tSlNKFbS5I9XWpdkCaTOnehe2UXRBOxBkXn2vQFZmvQ73XoxwuwH uB3eWL67fksYd/lNU66typU3VfS3XH9VvT82o6Xjd6nDa Pwzizx6L39Qxmo7XFF1LK1avQs n6pg2q5XUaRJnT 7y8rJsaGK3uiqXDrwtj/7wgGwmSdzKynLnyU9 tL8vtoUs0rbzrDMfHZM nzVVHe/OsdvY3XQtoTkvPfdQtiXyxP6fZFsdde/UIT6xvrcUnVfZc 4Ww33fznufLtOniPZ3i7VVpWOqHLfNaiV1WwuYlGvXrsn8Rx/J3Ny8XJ29KrOzs0n5q6wsr3T66S/tm8MW0ko3Vfsrd4wvtC/vOGXatG7cfW57N 44X9V41r/KGFev431uvCJ2rDJ9ja2bsbFampg74vOLFx7JtkQOHvj o1dV5k6dXV/GrsGi9m51a umWwyt56lyrCbm5eo1Xt4Yf7/WTV5bWW7cOuO7ceOX4fYvMybUv i8yu7TEuL28WMoP06ZPoNixzXuHPLm2Va1vtLk/Pnz8rNjx/TfRnQWIT3x5EFbskXolLSDXLhwUY4fP56OxWC04UJs44uhjXPCYOi/bi3zlSZ5fYr t2KIX6zvG8N6Xjs577avWa07dUtLS5rWfn8XTrez tZ2VrSe9seuo8 /vgDaItY3ZpRnX10SKqbMnTrES98r3ML7Rrvs1J8tw3At1LpTd/r0aXnj9dc7i5r 6G dO3Ppi2DbHTuR3/3 rJw6dSobDQA7q qdN 7UARgGtZK6kydPZlvlnTlzJtsCgJ2lSVpVJHUA2q5WUgcAAIB2qfV36gAAANAuJHUAAAARIKkDA ACIAEkdAABABEjqAAAAIkBSBwAAEIGRxcVFvtIEAABgyPE9dQAAABHg41cAAIAIkNQBAABEgKQO AAAgAiR1AAAAESCpAwAAiABJHQAAQARI6gAAACJAUgcAABABkjoAAIAIkNQBAABEgKQOAAAgAiR 1AAAAESCpAwAAiABJHQAAQARI6gAAACJAUgcAABABkjoAAIAIkNQBAABEgKQOAAAgAiR1AAAAQ0/k/2bX2YAQVVYWAAAAAElFTkSuQmCC

leemcder
08-07-2020, 07:11 AM
Thanks for the reply. I have tried this and its not working. It works fine when the file type is .xls but when I try it with a word (.doc) file and I've also changed to .docx and none of this works. These are a screen shot of the email attachment and its definitely a .doc file so can't figure out why it works for when its .xls but not .doc

http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAnUAAABJCAYAAABb0NCrAAAAAXNSR0IArs4c6QAA AARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAjCSURBVHhe7d1PbBzVHcDxny2 XQyUIkoVR20PghJIgDggiRPijIJxYqOKAlJYDrUqkNgghIU5Rjj1FObRRT5BLDiSIQySqXtqI2H Ft1IsFFxCpgEOVtm6D0kgB20Jy/Kfzm52feX6aNzszO7ueff5 4ped9 a937x5O7v5MZssI5sJAQAAwFAbzR4BAAAwxEjqAAAAIkBSBwAAEAGSOgAAgAiQ1AEAAESApA4AA CACJHUAAAARIKkDAACIAEkdAABABEjqAAAAIkBSBwAAEAGSOgAAgAiQ1AEAAESApA4AACACJHUA AAARIKkDAACIAEkdAABABEjqAAAAIkBSBwAAEIGRxcXFzWwbAAAAQ2pkM5FtAwAAYEjx8SsAAEA ESOoAAAAiQFIHAAAQAZI6AACACJDUAQAARICkDgAAIAK1vtJkbm4u2wpbX1 XtbU1OXLkSNYCAO1w8d2L2Va H9w1Js9PTsr4 HjWAgDtVzupe rQoWR08jOS/Jawx42NDRkdHZWPP/5Ebt68KWNjYyR2AFpFk7pXfvlKVtvuD2fPyq9efVUuX75MYgdgqNT6 FXzQP2V/mQ5oT1qQqfu3Lkjhw8fTu/YTU9Pp20AMAz23HuvTE1NyfSVK3Lr1q2sFQDarVZSp3fjihI7tbKyIvPz82mS57YDQJstLCykjy R2AIZNrY9fZ2Zm5Jmnn9LPXOXzz6/Jnj17dDP17bdLMnH/hNw/MSE3/ntDVldX5cuvvpLJyclOB499bKtsKtqWt11Hr MHrep8e10rHeNyY7n8uN32G39 Kq v20 ViZ83RuuhsX5/7C77jr2TbRV77cnv5M233spqIt/cvp1 FPvzl1/OWqpdS6HrtBdNXsturF7jNjmvkF6O0Y/5aUylcQe5fv04l17YOpjQ3Nx vfZx99kYv7/fz5UXQ sWy1ifolhtUSupu5L8l uzzzydnuA///VveWDvXhkZHUnr169flxs3vpYHH3xAJpLETn344RU5evRouu0KLVCTCzcMT4Kr6nx7PT9/vNVD7abMcd0 RdsmFN/6uPtVUcyiWH4c7A6a1P390mtZLZ/2eXRs z8EO3jwoIyP37ft7 BVuY6Krse6mryO2xorZBDHKKvpuVSJ16Z1UP588uZXp0 e0Dhl7VZXoXhunNC2KtrXNr19/JqUjY112dhM6hudk9ybJHj79 1L79gVKbsw2s l9bw2e3T3hdqNtZfdV7ZNFdVt2x8Xand122dsu6h/Ffpc9RIn9FzbdeTS47htobHG7w EaNJmZfHm0rZHLeq999/fVty7dt34rzfbtna/bvy6cvu63HZ3n9XdtjxF/fy2vH5W9/eF2l15 7qNs/a8fapov9 et 33MdZetN8e3W2Tt99Ym99eJDQmFKdbu7/f75tX99uK6HuyH99/ny7Tp4xQ7LKx6h63jWoldfqPH/T8dRE620kleV5 M/Nr fR/n8nd99y9lfhZ/ybYwmtxLwSVt8 Ob 0 a9fixnNjaSnb5sboxh1r43TbHm3b5Y4pI 8YTdKYVnaKnaPPnVvZ9UL83Dt1F/78afo4s/CP9PHd376YPqpz585tlbLsWnNfb3btWbtfV3njTN71a3Ubo9wYWvw4xu9XxO3rx8vbZ/Gs3Vc1nnLbtfj8/aGxIW6f0NjQeGsv6hOKb21 e0hoPqH4Zdq1lBWK1wY2t7pC47XdSi/xB63nO3Xra tJPjcij/3pSfnjf/4iP51 KWnXPkkil/XR/k2xRfbVXfRQvH6rM18dU2WuZY9ha6Clyry0r5Wyqh6jLnduVdYMu8cHV7/oPM52Hh/f/ P0UZ04cWKrVGGvo6pC4wbxWinS9LwGeZ5lXvv9Xt i KG1qKLf8V1Nx2uCzqdfz6HGtdK28y5SO6lLzlR/tr5keOHFv8mhh6fk0tSlNKFbS5I9XWpdkCaTOnehe2UXRBOxBkXn2vQFZmvQ73XoxwuwH uB3eWL67fksYd/lNU66typU3VfS3XH9VvT82o6Xjd6nDa Pwzizx6L39Qxmo7XFF1LK1avQs n6pg2q5XUaRJnT 7y8rJsaGK3uiqXDrwtj/7wgGwmSdzKynLnyU9 tL8vtoUs0rbzrDMfHZM nzVVHe/OsdvY3XQtoTkvPfdQtiXyxP6fZFsdde/UIT6xvrcUnVfZc 4Ww33fznufLtOniPZ3i7VVpWOqHLfNaiV1WwuYlGvXrsn8Rx/J3Ny8XJ29KrOzs0n5q6wsr3T66S/tm8MW0ko3Vfsrd4wvtC/vOGXatG7cfW57N 44X9V41r/KGFev431uvCJ2rDJ9ja2bsbFampg74vOLFx7JtkQOHvj o1dV5k6dXV/GrsGi9m51a umWwyt56lyrCbm5eo1Xt4Yf7/WTV5bWW7cOuO7ceOX4fYvMybUv i8yu7TEuL28WMoP06ZPoNixzXuHPLm2Va1vtLk/Pnz8rNjx/TfRnQWIT3x5EFbskXolLSDXLhwUY4fP56OxWC04UJs44uhjXPCYOi/bi3zlSZ5fYr t2KIX6zvG8N6Xjs577avWa07dUtLS5rWfn8XTrez tZ2VrSe9seuo8 /vgDaItY3ZpRnX10SKqbMnTrES98r3ML7Rrvs1J8tw3At1LpTd/r0aXnj9dc7i5r 6G dO3Ppi2DbHTuR3/3 rJw6dSobDQA7q qdN 7UARgGtZK6kydPZlvlnTlzJtsCgJ2lSVpVJHUA2q5WUgcAAIB2qfV36gAAANAuJHUAAAARIKkDA ACIAEkdAABABEjqAAAAIkBSBwAAEIGRxcVFvtIEAABgyPE9dQAAABHg41cAAIAIkNQBAABEgKQO AAAgAiR1AAAAESCpAwAAiABJHQAAQARI6gAAACJAUgcAABABkjoAAIAIkNQBAABEgKQOAAAgAiR 1AAAAESCpAwAAiABJHQAAQARI6gAAACJAUgcAABABkjoAAIAIkNQBAABEgKQOAAAgAiR1AAAAQ0/k/2bX2YAQVVYWAAAAAElFTkSuQmCC

26961

gmayor
08-07-2020, 10:06 PM
What is the extension of the attachment?
If it is docx then as the macro looks for the last four characters, searching for ".docx" of ".doc" are not going to work. You need to search for "docx".

leemcder
08-09-2020, 07:26 AM
Thank you, this is now working. Thanks again for you help, its much appreciated