A dictionary would probably help in this case, it's designed for scripting, and while it won't let you create 'dynamic' variables, the dictionary's items are dynamic, and can serve similar purpose as 'variables'. Dim Teams as Object Set Teams = CreateObject('Scripting.Dictionary') For i = 1 To x Teams(i) = 'some value' Next Later, to query the values, just call on the item like: MsgBox Teams(i) Dictionaries contain key/value pairs, and the keys must be unique. Assigning to an existing key will overwrite its value, e.g.: Teams(3) = 'Detroit' Teams(3) = 'Chicago' Debug.Print Teams(3) '## This will print 'Chicago' You can check for existence using the.Exist method if you need to worry about overwriting or not. If Not Teams.Exist(3) Then Teams(3) = 'blah' Else: 'Teams(3) already exists, so maybe we do something different here End If You can get the number of items in the dictionary with the.Count method. MsgBox 'There are ' & Teams.Count & ' Teams.' , vbInfo A dictionary's keys must be integer or string, but the values can be any data type (including arrays, and even Object data types, like Collection, Worksheet, Application, nested Dictionaries, etc., using the Set keyword), so for instance you could dict the worksheets in a workbook: Dim ws as Worksheet, dict as Object Set dict = CreateObject('Scripting.Dictionary') For each ws in ActiveWorkbook.Worksheets Set dict(ws.Name) = ws Next.
Hello everyone. Let me start by saying, please be gentle, I’m not a programmer but I’m a tech. Programming is not my area of expertise. That being said, my users were using Eudora as a mail client.
Eudora has an option to automatically save mail attachments to a distant folder. In our case the attachments are saved to a network folder. We are replacing Eudora with Outlook but unfortunately Outlook does not offer this option. I found multiple scripts on the web but most was just too complicated for my needs so I managed to simplify one and make it work. Here is the script: VBA Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String saveFolder = 'c: temp ' For Each objAtt In itm.Attachments objAtt.SaveAsFile saveFolder & ' ' & objAtt.DisplayName Set objAtt = Nothing Next End Sub /VBA Now the issue I have is that if I receive multiple emails with attachments that have the same name, witch is often the case here, the latest attachment will overwrite the older attachment without warning.
What I’m trying to do in the script bellow is to rename the attachments when they come in by adding a decimal at the end of the file name. Unfortunately my script bellow does not work. It runs in a loop non stop and I have no clue what I’m doing thus no clue how to fix this or what is missing. VBA Public Sub saveAttachtoDisk(itm As Outlook.MailItem) On Error Resume Next Dim objAtt As Outlook.Attachment Dim saveFolder As String Dim stFileName As String Dim i As Integer saveFolder = 'c: temp' For Each objAtt In itm.Attachments stFileName = saveFolder & ' ' & objAtt.DisplayName i = 0 While FileLen(stFileName) 0 If Err 0 Then Err = 0 i = i + 1 stFileName = saveFolder & ' ' & Str(i) & objAtt.DisplayName MsgBox stFileName Wend If Err 0 Then Err = 0 objAtt.SaveAsFile stFileName Set objAtt = Nothing Next End Sub /VBA Is there a genius out here that can help me with this? Thanks a bundle. Hi I use the following variation of the same script in Outlook 2003 to insert the date and time stamp before the file extension (not very elegant but it works) Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String saveFolder = 'c: a' For Each objAtt In itm.Attachments posr = InStrRev(objAtt.FileName, '.'
Increment Range In Vba
) ext = Right(objAtt.FileName, Len(objAtt.FileName) - posr) posl = InStr(objAtt.FileName, '.' ) fname = Left(objAtt.FileName, posr - 1) objAtt.SaveAsFile saveFolder & ' ' & fname & ' & Format(itm.ReceivedTime, 'ddmmyyyyhhmm') & '.' & ext Set objAtt = Nothing Next End Sub. Hi I use the following variation of the same script in Outlook 2003 to insert the date and time stamp before the file extension (not very elegant but it works) Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String saveFolder = 'c: a' For Each objAtt In itm.Attachments posr = InStrRev(objAtt.FileName, '.' ) ext = Right(objAtt.FileName, Len(objAtt.FileName) - posr) posl = InStr(objAtt.FileName, '.' ) fname = Left(objAtt.FileName, posr - 1) objAtt.SaveAsFile saveFolder & ' ' & fname & ' & Format(itm.ReceivedTime, 'ddmmyyyyhhmm') & '.'
& ext Set objAtt = Nothing Next End Sub This script works but for us it’s more work. The clients send us a huge amount of emails per day. All these attachments have long file names. Adding the date and time to every file gives them more work since when the attachment is translated it need to be returned to the client with the original file name.
With this script, the user needs to delete the added date and time. All this is additional work. What I need is to rename an attachment only if a file with the same name already exists in the folder. Let say I have a file “autosave.doc” in my C: attachment folder and I receive a new email with a file named autosave.doc.
I would like the script to check if a file with that name already exists, if so, rename it autosave1.doc. I’m sure that this is possible but I’m not a programmer and have no clue on how configure it. Look at the en for the code I use now. Change the saveFolder = path to your needs. In Outlook press on Alt-F11. On the left pane click on Project1, Microsoft office outlook, ThisOutllokSession then paste the code in the right pane. Save and the click on Debug, Compile project1.
Sims 3 ambitions free download full version for android. Free download. Version: v.4.10.1 US. The patch is designed to play The Sims 3: Ambitions as issued in the United States. Before installing the fix we need to. Download The Sims 3 Ambitions APK for Android, 100% safe and virus free download. We created an app for all of you fans out there like us who are addicted to the game. Reviews of The Sims 3 Ambitions.
You will then need to create a rule in Outlook to run the script for incoming mail. Tools, Rules and Alerts, New rules, Start from a blank rule, Check message when they arrive, Through a specific account, run a script, next and finish. VBA Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String saveFolder = 'k: download' For Each objAtt In itm.Attachments stFileName = saveFolder & ' ' & objAtt.DisplayName i = 0 JumpHere: If Dir(stFileName) = ' Then objAtt.SaveAsFile stFileName Else i = i + 1 stFileName = saveFolder & ' ' & i & ' - ' & objAtt.DisplayName GoTo JumpHere End If Set objAtt = Nothing Next End Sub /VBA. Hi, Thank you for this code. This worked perfect for me except.the emailsbeing sent to me contain multiple sub-email attachments (items) with the.csvfiles I need!
In other words, I have one email that contains multiple email attachments(see att), and each of those email attachments contains the file I need. Is itpossible to extract those files to a folder?
I don't need the emails, just thefiles (they happen to be.csv files each one named the same thing so I thinkthe current code will handle renaming them to a sequential file name). Please don't yell at me, I did not ask for this set up but that's the way I'm getting it sent to me! Please help if you can.
This is what works for me. I've been using it for years. Just pass the mail object and the folder path you want to save the attachments to the sub and it will save all the attachments for you and if there are multiples of the same name it will add a file number like windows does when it makes copies. IE filename(1).csv VBASub downloadmail(myMailItem, strPath As String) Dim strFileName As String Dim strNewName As String Dim strPre As String Dim strExt As String Dim myolAttachments As Attachments Dim myolAtt As Attachment Dim intExtlen As Integer Dim w As Integer Dim fs Set fs = CreateObject('Scripting.FileSystemObject') If myMailItem.Attachments.Count 0 Then Set myolAttachments = myMailItem.Attachments For Each myolAtt In myolAttachments strFileName = myolAtt.DisplayName 'find out if the file exists in the download location already and if so rename 'to a filename including a number eg. File(1).xls If fs.fileexists(strPath & ' ' & strFileName) = True Then strNewName = strFileName 'get the length of the extension including the. IntExtlen = Len(strFileName) - InStrRev(strFileName, '.'
) + 1 'check there is actually a file extension and if not set extension to blank 'and set strPre to the full file name If InStrRev(strFileName, '.' This is what works for me. I've been using it for years. Just pass the mail object and the folder path you want to save the attachments to the sub and it will save all the attachments for you and if there are multiples of the same name it will add a file number like windows does when it makes copies. IE filename(1).csv I was wondering if I could get some assistance with your code. I have successfully used this code: VBA Public Sub SaveAttachments 'Note, this assumes you are in the a folder with e-mail messages when you run it. 'It does not have to be the inbox, simply any folder with e-mail messages Dim App As New Outlook.Application Dim Exp As Outlook.Explorer Dim Sel As Outlook.Selection Dim AttachmentCnt As Integer Dim AttTotal As Integer Dim MsgTotal As Integer Set Exp = App.ActiveExplorer Set Sel = Exp.Selection 'Loop thru each selected item in the inbox For cnt = 1 To Sel.Count 'If the e-mail has attachments.
If Sel.Item(cnt).Attachments.Count 0 Then MsgTotal = MsgTotal + 1 AttTotal = AttTotal + Sel.Item(cnt).Attachments.Count 'For each attachment on the message. For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count 'Get the attachment Dim att As Attachment Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt) 'Save it to disk att.SaveAsFile ('H: Attachments ' + att.FileName) Next End If Next 'Clean up Set Sel = Nothing Set Exp = Nothing Set App = Nothing 'Let user know we are done Dim doneMsg As String doneMsg = 'Completed saving ' + Format$(AttTotal, '#,0') + ' attachments in ' + Format$(MsgTotal, '#,0') + ' Messages.' MsgBox doneMsg, vbOKOnly, 'Save Attachments' Exit Sub ErrorHandler: Dim errMsg As String errMsg = 'An error has occurred.
Error ' + Err.Number + ' ' + Err.Description Dim errResult As VbMsgBoxResult errResult = MsgBox(errMsg, vbAbortRetryIgnore, 'Error in Save Attachments') Select Case errResult Case vbAbort Exit Sub Case vbRetry Resume Case vbIgnore Resume Next End Select End Sub /VBA But I would like to integrate the code that adjusts for files of the same name (by adding a number at the end of the file). Where in my code do I insert the code you posted above?
Thank you for the help.
A dictionary would probably help in this case, it's designed for scripting, and while it won't let you create 'dynamic' variables, the dictionary's items are dynamic, and can serve similar purpose as 'variables'. Dim Teams as Object Set Teams = CreateObject('Scripting.Dictionary') For i = 1 To x Teams(i) = 'some value' Next Later, to query the values, just call on the item like: MsgBox Teams(i) Dictionaries contain key/value pairs, and the keys must be unique. Assigning to an existing key will overwrite its value, e.g.: Teams(3) = 'Detroit' Teams(3) = 'Chicago' Debug.Print Teams(3) '## This will print 'Chicago' You can check for existence using the.Exist method if you need to worry about overwriting or not.
Download game for windows 7. If Not Teams.Exist(3) Then Teams(3) = 'blah' Else: 'Teams(3) already exists, so maybe we do something different here End If You can get the number of items in the dictionary with the.Count method. MsgBox 'There are ' & Teams.Count & ' Teams.'
, vbInfo A dictionary's keys must be integer or string, but the values can be any data type (including arrays, and even Object data types, like Collection, Worksheet, Application, nested Dictionaries, etc., using the Set keyword), so for instance you could dict the worksheets in a workbook: Dim ws as Worksheet, dict as Object Set dict = CreateObject('Scripting.Dictionary') For each ws in ActiveWorkbook.Worksheets Set dict(ws.Name) = ws Next.