Call macros based on characters of a filename - vba

How can I call macros based on the left n characters of a filename?
Details:
I get emailed many files per month whose names contain a few characters followed by a date or serial number.
For example
- Accounts receivable files are named ARDET 25-01-16.xls, ARDET 19-01-16.xls , ARDET 31-12-15.xls and so on
- Invoicing files are named Bkg_Inv_01.xls, Bkg_Inv_02.xls, Bkg_Inv_03.xls and so on
I have recorded various macros to run on these files. For example, I have Sub ARDET() and Sub Bkg_Inv() to handle the above files.
I want to create a single macro to call the above Subs if the first 5 characters of the filename matches certain text.
The code I am looking for needs to be roughly in the following syntax:
Sub Call_Macro_if_leftn_is()
' Making variables
This_File_name = Currently open file's filename
n = InputBox("Enter the total number of characters from the left of the filename to match")
y = Left n characters of This_File_name
'If Then statements to call other macros
If y = ARDET
Call ARDET()
Else if y = Bkg_I
Call Bkg_Inv()
Else if y = PDC_I
Call PDC_Inv()
Else Msgbox "Filename does not match specified characters"
End Sub

I'd try a set-up something like this:
Sub RunCodeBasedOnFileName()
Dim fileID As String
fileID = VBA.Left$(ThisWorkbook.Name, 5)
If fileID = "ARDET" Then
ARDET
ElseIf fileID = "Bkg_I" Then
Bkg_I
ElseIf fileID = "PDC_I" Then
PDC_I
Else
MsgBox "This file is of unknown origin!"
End If
End Sub
Sub ARDET()
'Do stuff
End Sub
Sub Bkg_I()
'Do stuff
End Sub
Sub PDC_I()
'Do stuff
End Sub
You don't need to use Call or have the parentheses () when calling a sub
I'd avoid getting people to input the first 5 characters - instead get it programmatically
The only bit I am unclear about is where you are running this code from and how you are iterating over the files that you are sent?
Where I have ThisWorkBook this requires the code to be running in the actual file. I think you'll need to modify that e.g. you loop over a bunch of files in a folder and access the filename that way.

Thanks Alex. I will test your code and tell you how it works.
I get such files through email atleast 10 times a day. I run my macros on files before I store them in folders named by month and category of file.
But coming to think of it, your idea of iterating through files in a folder is great ! Could you have the same code iterate over all files in a folder, and preferably, its sub folders as well?
My files are stored in folders in a hierarchy that goes like
- "C:\Dropbox\Work\2016\Jan\ARDET Jan" or
- "C:\Dropbox\Work\2016\Jan\BkgInv Jan"

Related

Inbox Rule to Send Alert When Rate of Emails Increases

I receive hundreds of automated alerts everyday (for things like CPU/Memory spikes, SQL Blocks). However, usually, there's nothing that I can/want to do when these alerts come in; I only care when there is a surge of alerts, because that's abnormal. I do at least have them going to separate folders, but that's still distracting, because I have to always be somewhat mindful of that unread email number.
Is there some way to alert me when I get, say, more than X number of emails from sendername within N minutes?
Using Outlook, Office 365
I tried looking for Outlook add-ins, but it's a difficult question to describe to Google. I know a tiny bit of VBA, but not enough to get me started on this.
Basically, you have to run a timer to periodically run a scanner for the number of emails arrived in your inbox. In the event handler fired by the timer (usually called Tick) you can use the Find/FindNext or Restrict methods of the Items class.
The simplest and fastest way is to create a VBA macro. See Getting started with VBA in Office and Using Visual Basic for Applications in Outlook articles to get started quickly.
The following articles can help you with coding the required algorithm on top of described methods for looking Outlook items:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
Advanced search in Outlook programmatically: C#, VB.NET
To run a timer periodically you can use the SetTimer function.
See Outlook VBA - Run a code every half an hour for the sample code.
Public Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long, TimerSeconds As Single
Dim Counter As Long
' Start Timer
Sub StartTimer()
' Set the timer for 1 second
TimerSeconds = 1
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
' End Timer
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
Debug.Print Now
' call your code here
End Sub
I assume from your question that you were hoping someone had already developed a solution to your problem. Perhaps they have but I think it is unlikely that they would post that solution for others to find. I think you will have to develop your own solution. The approach I have developed is very different from Eugene’s. Between us, we offer some interesting ideas for you to select from.
I do not believe the VBA needed is particularly advanced. You may already know enough, particularly with two answers to study. If not, I would start with Excel VBA. I have failed to find an Outlook VBA tutorial I like but have seen of several Excel VBA tutorials that look good. I prefer books. I visited a good library, looked at several Excel VBA Primers and borrowed the most promising to try at home.
You will also need to understand the Outlook Object model. An Excel VBA tutorial will teach you about workbooks, worksheets, ranges, cells and so. For Outlook, you need to understand stores, folders, mail items, calendar items and so on. As I said, I have failed to find an Outlook VBA tutorial I like and I do not like the high recommended book I bought. I learnt my Outlook VBA by experimentation. Eugene has included explanations in his answer and I will include explanations in mine. Hopefully between us we will give you enough of a start. You might be lucky to find a post that explains topics A, B and C together. I find it better to look up topics individually and then write experimental macros that combine them. If you fail with an experimental macro, post it here with an explanation of what you are trying to achieve and what is going wrong; you will almost certainly get help.
To emulate your problem, I picked four suppliers that email me often enough to develop and test my monitoring code. You say you use rules to move these emails to separate folders which seems a good idea to me. Rules offer a number of classifications by which an email can be selected and I gather you can select these emails from your input stream. Rules also offer a number processing options. You have used “Move to a folder”. Another is “Run a script”. A script in this context is an Outlook VBA macro with a specific structure. I was confident, I could create a macro to perform the monitoring you require. However, there is a problem: Outlook runs the macro before it moves the email to the new folder. This is not a big problem but it means you cannot use the rule to move the email. You must get the macro to move the email which is not difficult.
I created a rule for each supplier for which the summary was:
Apply this rule after the message arrives
from Xxxxx
and on this computer only
run Project1.Yyyyy
and stop processing more rules
“Xxxxx” is the name of a supplier and “Yyyyy” is the name of the macro that will process the email. I am a home user so “and on this computer only” has no effect for me but it might for you. Without “and stop processing more rules” you will get messages saying the email cannot be found because Rule X moves the email then Rule Y cannot find it in Inbox.
Macro Yyyyy is of the form:
Public Sub Yyyyy(ByRef itm As MailItem)
Call CountAndWarn("test folders\Xxxxx", itm, 2, 180, 3, 600)
End Sub
The names of the macros are not important. Clearly if a rule says run macro Yyyyy there must be a macro Yyyyy but the value of Yyyyy is not important. I named my macros after Outlook’s names for the suppliers but you will presumably have to name them after the type of email.
The format of the first line, Public Sub Yyyyy(ByRef itm As MailItem) is more or less fixed for a macro to be run by a rule. The first parameter must be the MailItem. There are further optional parameters for which I have never had a use.
CountAndWarn is a macro I have written to process all these emails. It has at least four parameters but can have six or eight or more if that would be helpful for a particularly type of email.
"test folders\Xxxxx" identifies the folder to which the email is to be moved.
If you look at your Outlook folder pane, you will see at least one name against the left edge. Under that, but indented, will be system folders such as Inbox, Deleted Items, Sent Items and Outbox. Under any of the system folders, you can have private subfolders. You can also have private folders, at the same level as the system folders, any of which can have sub-folders and sub-sub-folders to any depth. The name against the left edge identifies a store. A store is a file in which Outlook stores emails, appointments, tasks and so on. You will have at least one store into which your emails are loaded. You may also have shared stores which can be public to your entire organisation or private to your team or department. You can have at many private stores as you wish.
On my system, I have one store per email address (I have three) plus several private stores. In "test folders\Xxxxx", “test folders” is the name of a private store I use for experimentation. Within “test folders” I have created four folders, one per supplier I am monitoring. Within each of these folders, I have a sub-folder “Old” which I will explain later. So within my folder pane, I have a section that looks like:
test folders
Xxxxx
Old
Wwwww
Old
Vvvvv
Old
Uuuuu
Old
As I have said, "test folders\Xxxxx" identifies a folder. The format of this string is “StoreName\FolderName\SubFolderName\SubSubFolderName …”. I have placed my folders in an experimental store; you have probably placed your folders in your main store. You can place them anywhere you have write permission. This string must specify the entire name of the folder starting with the store name. Your names might be: “YourMainStore\Inbox\CPU Spikes” and “YourMainStore\Inbox\SQL Blocks”.
Returning to Call CountAndWarn("test folders\Xxxxx", itm, 2, 180, 3, 600).
The second parameter, itm, passes the email to CountAndWarn so it can move the email to the specified folder.
The remaining parameters are one or more pairs of integers of which the first is a count of emails and the second is a number of minutes. My parameter list means I wished to be warned if:
2 emails have arrived in the last 180 minutes from supplier Xxxxx
3 emails have arrived in the last 600 minutes from supplier Xxxxx
I do not receive many of these emails per day so my counts are low and my periods are long. Your counts will be much higher and your periods much shorter.
I do not know if you might wish to monitor different periods but there was little extra code to allow for several periods so I included it. You must have at least one count and one period but you can have as many extra pairs as you wish. If you have multiple periods, they must be in ascending sequence with the longest period last.
The macro CountAndWarn does the following:
Locate the named destination folder, for example, "test folders\Xxxxx".
Locate the corresponding “old” folder, for example, "test folders\Xxxxx\Old".
Move the email to the destination folder
Count the emails in each period. If an email is older than the end time of the last period, move it to the “old” folder so it is not checked every time a new email arrives.
If any of the counts exceeds the maximum for its period, a message box like the following is displayed.
These macros could be ideal if all you want is an instant warning of every spike during the day. Deficiencies include:
While a spike continues, you will be warned about each new email.
You will not be warned about a spike in the middle of the night.
The first deficiency could not be fixed without keeping records. For example, macro CountAndWarn counts the emails in a folder and reports a high count. It does not record that it warned you about the current spike ten seconds ago when the last email arrived. Keeping records in a text file would not be difficult but you will need to think about what records will help you analyse the spikes.
Spikes in the middle of the night will require analysis of the old emails. The current macro just counts emails in the last X minutes. Reviewing last night’s emails will involve counting the emails in every X minute period since close of play yesterday. That analysis probably will not require any obscure VBA but will require some careful design.
Come back with questions, if you do not understand anything in the following macros:
Option Explicit
Public Sub Argos(ByRef itm As MailItem)
Call CountAndWarn("test folders\Argos", itm, 2, 180, 3, 600)
End Sub
Public Sub Guardian(ByRef itm As MailItem)
Call CountAndWarn("test folders\Guardian", itm, 1, 600, 2, 1200, 3, 1800)
End Sub
Public Sub Amazon(ByRef itm As MailItem)
Call CountAndWarn("test folders\Amazon", itm, 2, 600)
End Sub
Public Sub Wayfair(ByRef itm As MailItem)
Call CountAndWarn("test folders\Wayfair", itm, 2, 600)
End Sub
Sub CountAndWarn(ByVal FldrDestName As String, ByRef itm As MailItem, _
ParamArray CountPeriod() As Variant)
Dim CountsCrnt() As Long
Dim CountsTgt() As Long
Dim FldrDest As Outlook.Folder
Dim FldrDestNamePart() As String
Dim FldrOld As Outlook.Folder
Dim InxC As Long
Dim InxCS As Long
Dim InxFldrName As Long
Dim InxItem As Long
Dim LB As Long
Dim Msg As String
Dim NumCounts As Long
Dim Periods() As Date
Dim Recent As Boolean
Dim Warn As Boolean
FldrDestNamePart = Split(FldrDestName, "\")
LB = LBound(FldrDestNamePart) ' Should be zero but just in case
' Set FldrDest to Store
On Error Resume Next
Set FldrDest = Session.Folders(FldrDestNamePart(LB))
On Error GoTo 0
If FldrDest Is Nothing Then
Debug.Assert False ' Store doesn't exist
Exit Sub
End If
' Set FldrDest to destination folder
For InxFldrName = LB + 1 To UBound(FldrDestNamePart)
On Error Resume Next
Set FldrDest = FldrDest.Folders(FldrDestNamePart(InxFldrName))
On Error GoTo 0
If FldrDest Is Nothing Then
Debug.Assert False ' Subfolder doesn't exist
Exit Sub
End If
Next
'Set FldrOld to the Old folder for FldrDest
On Error Resume Next
Set FldrOld = FldrDest.Folders("Old")
On Error GoTo 0
If FldrOld Is Nothing Then
Debug.Assert False ' No subfolder "Old" within destination folder
Exit Sub
End If
' Move new email from Inbox to FldrDest
itm.Move FldrDest
'Debug.Print "CountPeriod";
'For InxCS = LBound(CountSince) To UBound(CountSince)
'Debug.Print " " & CountSince(InxCS);
'Next
'Debug.Print
' Determine number of counts and periods in CountPeriod
' No check for an odd number of values in CountPeriod
NumCounts = (UBound(CountPeriod) - LBound(CountPeriod) + 1) / 2
' Size arrays according to number of counts
ReDim CountsCrnt(1 To NumCounts)
ReDim CountsTgt(1 To NumCounts)
ReDim Periods(1 To NumCounts)
' Initialise arrays and convert periods in minutes to a time
InxC = 1
For InxCS = LBound(CountPeriod) To UBound(CountPeriod) Step 2
CountsTgt(InxC) = CountPeriod(InxCS)
CountsCrnt(InxC) = 0
Periods(InxC) = DateAdd("n", -CountPeriod(InxCS + 1), Now())
InxC = InxC + 1
Next
'Debug.Print FldrDest.Name
'Debug.Print "New " & itm.ReceivedTime
For InxItem = FldrDest.Items.Count To 1 Step -1
With FldrDest.Items(InxItem)
'Debug.Print .ReceivedTime & " ";
Recent = False
For InxC = 1 To NumCounts
If .ReceivedTime > Periods(InxC) Then
CountsCrnt(InxC) = CountsCrnt(InxC) + 1
Recent = True
Exit For
End If
Next
End With
If Recent Then
'Debug.Print "Index " & InxC & " Count " & CountsCrnt(InxC)
Else
'Debug.Print "Old: Moved"
FldrDest.Items(InxItem).Move FldrOld
End If
Next
' Check counts to see if warning required
Warn = False
For InxC = 1 To NumCounts
If InxC > 1 Then
' Add in count of more recent emails
CountsCrnt(InxC) = CountsCrnt(InxC) + CountsCrnt(InxC - 1)
'Debug.Print "CountsCrnt(InxC) := " & CountsCrnt(InxC)
End If
If CountsCrnt(InxC) >= CountsTgt(InxC) Then
Warn = True
End If
Next
If Warn Then
' At least one count in excess of maximum
Msg = "Warning. Emails in " & FldrDestName
For InxC = 1 To NumCounts
Msg = Msg & vbLf & CountsCrnt(InxC) & " since " & Format(Periods(InxC), "ddd h:mm:ss")
Next
Call MsgBox(Msg, vbOKOnly)
End If
End Sub

Open File based on Dictionary Value matched to Public Variable

I have an excel file with a list of codes in column 1 relating to different workbooks.
At first I created a code that would loop through the codes and I would manually open the specific workbook using "Application.GetOpenFilename".
Now, I decided to make it more efficient and because the file path doesn't change I figured I'd create a global public variable with the file path location.
I create a dictionary that adds all the codes. (That is the loop between 2 and 50) The value in each row of Cells(i,1) contains an abbreviated code which is then tied to a public variable with the full file path/location. In this case, all the codes in rows 2 through 50 are ABC123 (key = ABC123). Other times I have multiple codes, which is why I add to a dictionary to keep the unique values and can then open these individual files.
I was hoping to loop through the dictionary to open the specific files related to the code, instead it tried to open the string value rather than the file path. ABC123.xls rather than C:\Users\xxxx\xxxx\ImportantFile2018.xls
I'm trying to figure how to get the dictionary key to equal the public variable I assigned with the same name.
Do not get hung up on variable names, these are just examples. The major issue is how to retrieve the variables value (file path) when the variable name (ABC123) matches a cell's value. Every cell value in column 1of the data has a matching variable with a filepath.
Option Explicit
Public ABC123 As String
Sub DefinedVariables()
ABC123 = C:\Users\xxxx\xxxx\ImportantFile2018.xls
End Sub
Sub Reporting_Update()
Dim dictClient As New Scripting.Dictionary
Dim key As Variant
Call DefinedVariables
For i = 2 To 50
If dictClient.Exists(Cells(i, 1).Value) Then
Else:
dictClient.Add Cells(i, 1).Value
End If
Next
For Each key In dictClient
Workbooks.Open FileName:=key

Hyperlinks in VBA

I want to create a button in Excel which links to:
http://datafeed.api.productserve.com/datafeed/download/apikey/50f70c7de11f99fe127d7ad4c8e37e31/cid/97,98,142,144,
...
,567,569/fid/4319/columns/merchant_product_id,merchant_category,brand_name,product_name,mpn,search_price,aw_deep_link,specifications,valid_from,valid_to,in_stock,warranty,aw_product_id,merchant_image_url,description/format/csv/delimiter/,/compression/gzip/adultcontent/1/
I've cut out a large section in the middle, but it is just a long sequence of numbers separated by commas. In total the URL is 1939 characters long.
Copying the URL into a browser works fine - it is a download link and the file opens as it should.
The code for the button is simple:
Private Sub download_button_Click()
Dim feed_hyperlink As String
feed_hyperlink = *"http://data... "*
ActiveWorkbook.FollowHyperlink feed_hyperlink
End Sub
When I run the procedure, I get the following error:
Run-time error '5': Invalid procedure call or argument
Hyperlinking a cell restricts the destination URL to 255 characters. Is a character limit what's causing the issue here, or is there another problem?
I think you're right. It's probably too long as the longest one I can use before getting the same error is 1033 characters;
Sub Main()
Dim h As String
h = String(1034, "a")
Debug.Print Len(h)
ActiveWorkbook.FollowHyperlink h
End Sub

Excel: Populate cells with data from file names that use common naming convention

I have 1000+ files (mostly PDFs) that all follow a common naming convention, e.g.:
CA0001.02 Tax Return A-333 650.5ca 20140729.pdf
Each file has different information in its filename (the "CA number" is different, the "A-number" is different, the date is different, etc.).
I want to create a spreadsheet so that I can manipulate the data that these file names contain; in other words, take the 5 pieces of info listed in the filename and turn it into 5 columns in Excel.
In my research I've come across ways to insert the Excel filename into the current sheet, but that's not what I want. I want to insert the filenames of thousands of other files located elsewhere on the computer. My ideal solution would ensure that:
Each file gets its own row
Each field in the filename goes into the appropriate Excel column
Any filenames that are missing data wouldn't break the operation (e.g., if the date "20140729" wasn't at the end of the file, then the whole thing wouldn't break, it would just leave that cell empty and move to the next file).
I imagine this will require VBA or Command Prompt (and maybe something else?) but my skill with VBA is pretty weak. I would really appreciate any suggestions to get me started. Thanks!
Your question is too generic for a simple answer. The following VBA function with some help from Google should get you started:
Sub Test()
Dim FN As String, R As Integer
R = 1
FN = Dir("C:\*")
Do While FN <> ""
Cells(R, 1) = FN
If InStr(FN, "CA") Then Cells(R, 2) = "This contains CA!"
FN = Dir
R = R + 1
Loop
End Sub

GetCrossReferenceItems in msword and VBA showing only limited content

I want to make a special list of figures with use of VBA and here I am using the function
myFigures = ActiveDocument.GetCrossReferenceItems(Referencetype:="Figure")
In my word document there are 20 figures, but myFigures only contains the first 10 figures (see my code below.).
I search the internet and found that others had the same problem, but I have not found any solutions.
My word is 2003 version
Please help me ....
Sub List()
Dim i As Long
Dim LowerValFig, UpperValFig As Integer
Dim myTables, myFigures as Variant
If ActiveDocument.Bookmarks.Count >= 1 Then
myFigures = ActiveDocument.GetCrossReferenceItems(Referencetype:="Figure")
' Test size...
LowerValFig = LBound(myFigures) 'Get the lower boundry number.
UpperValFig = UBound(myFigures) 'Get the upper boundry number
' Do something ....
For i = LBound(myFigures) To UBound(myFigures) ‘ should be 1…20, but is onlu 1…10
'Do something ....
Next i
End If
MsgBox ("Done ....")
End Sub*
Definitely something flaky with that. If I run the following code on a document that contains 32 Figure captions, the message boxes both display 32. However, if I uncomment the For Next loop, they only display 12 and the iteration ceases after the 12th item.
Dim i As Long
Dim myFigures As Variant
myFigures = ActiveDocument.GetCrossReferenceItems("Figure")
MsgBox myFigures(UBound(myFigures))
MsgBox UBound(myFigures)
'For i = 1 To UBound(myFigures)
' MsgBox myFigures(i)
'Next i
I had the same problem with my custom cross-refference dialog and solved it by invoking the dialog after each command ActiveDocument.GetCrossReferenceItems(YourCaptionName).
So you type:
varRefItemsFigure1 = ActiveDocument.GetCrossReferenceItems(g_strCaptionLabelFigure1)
For k = 1 To UBound(varRefItemsFigure1)
frmBwtRefDialog.ListBoxFigures.AddItem varRefItemsFigure1(k)
Next
and then:
frmBwtRefDialog.Show vbModeless
Thus the dialog invoked several times instead of one, but it works fast and don't do any trouble. I used this for one year and didn't see any errors.
Enjoy!
Frankly I feel bad about calling this an "answer", but here's what I did in the same situation. It would appear that entering the debugger and stepping through the GetCrossReferenceItems always returns the correct value. Inspired by this I tried various ways of giving control back to Word (DoEvents; running next segment using Application.OnTime) but to no avail. Eventually the only thing I found that worked was to invoke the debugger between assignments, so I have:
availRefs =
ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem):Stop
availTables =
ActiveDocument.GetCrossReferenceItems(wdCaptionTable):Stop
availFigures = ActiveDocument.GetCrossReferenceItems(wdCaptionFigure)
It's not pretty but, as I'm the only person who'll be running this, it kind of works for my purposes.