Adding to code created from previous questions
gowflow,
You'll recognize this as something very similar to what you did with the MasterCard workbook.
For the Visa spreadsheet just worked on in the previous question, when the import of
Western Union emails is done I would like a function to automatically do the
following (it can also do it by clicking a button, if that is easier and less problematic):
1. Open a new spreadsheet with the column headings as indicated in the WU Spreadsheet attached.
2. For each row Where there is no date in Col J in 'WU-Staging-FBME', in Col P of 'WU-Staging-FBME' input: 'Wutoday's date'. (Example: WuOct17-11)
3. For each row Where there is no date in Col J in 'WU-Staging-FBME', copy the values from Cols: a through p and paste into the new spreadsheet, including the yellow highlighted blank rows
4.Save the new spreadsheet as Wutoday's date (same value as Col P - Example: WuOct17-11)
5. Allow me to review the inported data on the new spreadsheet.
6. when I click ok to the review, open up a new email
7. Address the email to: otto.weber@offshoreagle.co
8. Subject: Wutoday's date (same value as Col P)
9. And attach the just created spreadsheet
10. Add this to the body of the email:
"Hi Joseph,
Attached is the pick up request for the day.
Please send me your outstanding balance with us as of today.
Thank you!
Michael"
11. Insert into Col J of 'WU-Staging-FBME', today's date WU-Example.xls
You'll recognize this as something very similar to what you did with the MasterCard workbook.
For the Visa spreadsheet just worked on in the previous question, when the import of
Western Union emails is done I would like a function to automatically do the
following (it can also do it by clicking a button, if that is easier and less problematic):
1. Open a new spreadsheet with the column headings as indicated in the WU Spreadsheet attached.
2. For each row Where there is no date in Col J in 'WU-Staging-FBME', in Col P of 'WU-Staging-FBME' input: 'Wutoday's date'. (Example: WuOct17-11)
3. For each row Where there is no date in Col J in 'WU-Staging-FBME', copy the values from Cols: a through p and paste into the new spreadsheet, including the yellow highlighted blank rows
4.Save the new spreadsheet as Wutoday's date (same value as Col P - Example: WuOct17-11)
5. Allow me to review the inported data on the new spreadsheet.
6. when I click ok to the review, open up a new email
7. Address the email to: otto.weber@offshoreagle.co
8. Subject: Wutoday's date (same value as Col P)
9. And attach the just created spreadsheet
10. Add this to the body of the email:
"Hi Joseph,
Attached is the pick up request for the day.
Please send me your outstanding balance with us as of today.
Thank you!
Michael"
11. Insert into Col J of 'WU-Staging-FBME', today's date WU-Example.xls
ASKER
yes, similar to pushbook
I need to save the newly created spreadsheet here:
C:\Users\Michael\Desktop\M
I need to save the newly created spreadsheet here:
C:\Users\Michael\Desktop\M
well you should know my style by now .... you will decide where to save your file ...
gowflow
gowflow
ASKER
Ok, then what were you asking with: "if yes then also here need file/folder location ?"
I meant need to put the whole routine that will allow you to choose file/folder .... mmmm
gowflow
gowflow
ASKER
put it behind a button on the Main page I suppose
2 buttons, one to choose file/folder location one to activate the routine
gowflow
gowflow
ASKER
sure, sounds good.
Here it is
1) Save your latest version of the Visa file and give it a new name. We will call it your Production Workbook.
2) Open the file just created activate macros.
3) from with in the previous file press file/open and Open the attached file (make sure they both don't have the same name)
4) Press View Menu slect Arrange All and choose Vertical press ok you will have both workbook side by side.
5) press on Developper and choose Visual basic on the left pane you will see both workbooks Make sure to know which one is your production workbook and which one is the attached file. You will be copying from the attached file to your production file and not vice versa.
6) copy the below code in module1 (doubleclick on Module1 of your production file slect to view 1 sub at a time lower left icon) then after last line of the Declaration section paste the attached below code (SELECT ALL in the code window right click choose copy and paste in module1)
7) Still in module1 in the Declaration section after the line
Global gstFolderToTransfer As String
... add this line
Global gstFolderWesternUnion As String
8) SAVE your production workbook
9) Select the sub ImportWesternUnion() and in hte last line just before End Sub insert the following line so it will look like this
-----------
WMFileCreate WS
End Sub
-----------
10) SAVE Your production workbook
11) doubleclick on ThisWorkbook of your production workbook
12) Press on Edit Select All in the Menu and in the code right click and press Delete you will endup wit an empty code in Thisworkbook
13) Paste the below code in Thisworkbook that you just deleted. (SELECT ALL right click Choose COPY and paste in ThisWorkbook of your production file.)
14) SAVE your production workbook.
15) Doubleclick on the sheet MAIN in the left pane of your production file. Choose from the Edit Menu Select All then in the code right click Delete and you will endup with a blank page in the Main code window.
16) SELECT ALL from the below code and right click choose COPY and paste it in the Main Code of your production workbook.
17) SAVE your Production workbook.
18) Goto to your Excel sheet and display in both windows sheet Main. Select Developper menu and make sure that for both windows the Design button is clicked.
19) Select the Red label in the present attached file and press shift while holding shift press on the Red button so they are both selected release the shift button and right click (make sure the mouse is over the button) and choose copy
20) click on your production workbook so it get the focus and move the existing buttons if they are there and paste the items you just copied after the transfer combobox like in the attached sheet.
21) click anywhere else in hte Main worksheet so it remove the focus from the command button.
22) doubleclick on the red command button and make sure that the code is:
----------------
Private Sub CommandButton3_Click()
GetNewFolder
End Sub
---------------
The commanbutton should be 3 if it is not then you need to tell me what it is and I will let you know what the change will be.
23) SAVE the production workbook and exit it
24) Exit the attached file without saving it.
25) Try the new production workbook and let me know your feedback.
gowflow
1) Save your latest version of the Visa file and give it a new name. We will call it your Production Workbook.
2) Open the file just created activate macros.
3) from with in the previous file press file/open and Open the attached file (make sure they both don't have the same name)
4) Press View Menu slect Arrange All and choose Vertical press ok you will have both workbook side by side.
5) press on Developper and choose Visual basic on the left pane you will see both workbooks Make sure to know which one is your production workbook and which one is the attached file. You will be copying from the attached file to your production file and not vice versa.
6) copy the below code in module1 (doubleclick on Module1 of your production file slect to view 1 sub at a time lower left icon) then after last line of the Declaration section paste the attached below code (SELECT ALL in the code window right click choose copy and paste in module1)
Sub WMFileCreate(WS As Worksheet)
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow, I, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String
If gstFolderWesternUnion = "" Then
MsgBox ("You need to select a destination folder to store the western Union files created. Please go to Sheet 'Main' and select a folder before proceeding further.")
Exit Sub
Else
If MsgBox("This process will create a new workbook with all records in sheet 'WU-Staging-FBME' that have NO date in Col J." & Chr(10) & Chr(10) _
& "Are you ready to start this process ?", vbQuestion + vbYesNo, "Western Union File") = vbYes Then
Set NewWb = Workbooks.Add
Set NewWS = NewWb.Sheets("Sheet1")
NewWS.Name = "WU" & Format(Now, "mm-dd-yyyy")
'Visa - WUSept9-11.xls'
NewWb.SaveAs Filename:=gstFolderWesternUnion & "WU" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
NewWorkB = NewWb.Name
J = 1
MaxRow = WS.UsedRange.Rows.Count
WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
For I = 1 To MaxRow
If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
WS.Range("A" & I & ":P" & I).Copy NewWS.Cells(J, 1)
J = J + 1
End If
Next I
NewWS.Range("Q:Z").EntireColumn.Delete
'WS.ShowAllData
'WS.AutoFilterMode = False
'processCC NewWS
With NewWS.Columns("A:P")
.EntireColumn.AutoFit
.HorizontalAlignment = xlLeft
End With
Application.DisplayAlerts = False
For Each WSS In NewWb.Worksheets
If WSS.Name <> NewWS.Name Then WSS.Delete
Next WSS
NewWb.Save
'Set NewWb = Nothing
'Set NewWS = Nothing
Application.DisplayAlerts = True
'ws.Activate
MsgBox ("Workbook: '" & NewWorkB & "' has been created successfully")
If MsgBox("Are you ready to proceed with Email Creation and Update of 'WU-Staging-FBME' with today;s date in Col J ?", vbQuestion + vbYesNo, "Email Creation") = vbYes Then
For I = 1 To MaxRow
If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
WS.Range("J" & I) = DateValue(Now)
WS.Range("P" & I) = "WU" & Format(Now, "Mmmdd-yy")
J = J + 1
End If
Next I
WS.ShowAllData
WS.AutoFilterMode = False
SendEmail NewWb.FullName
Else
MsgBox ("Request Canceled by user, No Email created and Colj and P not updated in 'WU-Staging-FBME'")
End If
End If
End If
End Sub
Sub SendEmail(fName As String)
Dim wb As Workbook
Dim WS As Worksheet
Dim SendTo As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String
Application.DisplayAlerts = False
'Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")
'Fill in Subject Details'
subject_ = "WU" & Format(Now, "Mmmd-yy")
attach_ = fName
SendTo = "otto.weber@offshoreagle"
'Create the Email
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = SendTo
.Subject = subject_
.Attachments.Add (attach_)
.Body = "Hi Joseph," & Chr(10) & Chr(10) _
& "Attached is the pick up request for the day." & Chr(10) _
& "Please send me your outstanding balance with us as of today." & Chr(10) & Chr(10) _
& "Thank you." & Chr(10) & Chr(10) _
& "Michael" & Chr(10) _
& "Sovereign Gold Card Support" & Chr(10) _
& "www.sovereigngoldcard.com"
'Send the Email
.Display
End With
'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing
Application.DisplayAlerts = True
End Sub
Sub GetNewFolder()
gstFolderWesternUnion = GFolderName("Western Union File")
If gstFolderWesternUnion <> "" And Dir(gstFolderWesternUnion) <> "" Then
'Update CommandButton1 caption to show Actual Folder in use
Sheets("Main").CommandButton3.Caption = "Target Export Folder for PushToBook: <" & gstFolderWesternUnion & "> ... Activated"
Else
MsgBox ("No Folder has been selected or the Folder does not exist, therefore data cannot be Exported" _
& " until valid Folder has been selected." & Chr(10) & Chr(10) _
& "Please press on the command bar to choose a Folder.")
Sheets("Main").CommandButton3.Caption = "Browse"
With Application
.DisplayAlerts = True
.EnableEvents = True
End With
Exit Sub
End If
End Sub
Function GFolderName(fol As String) As String
Dim vrtSelectedItem
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.ActiveWorkbook.Path
.Title = "Please choose Folder location for: " & fol
.InitialView = msoFileDialogViewDetails
.Show
For Each vrtSelectedItem In .SelectedItems
GFolderName = vrtSelectedItem & "\"
Next vrtSelectedItem
End With
Set vrtSelectedItem = Nothing
End Function7) Still in module1 in the Declaration section after the line
Global gstFolderToTransfer As String
... add this line
Global gstFolderWesternUnion As String
8) SAVE your production workbook
9) Select the sub ImportWesternUnion() and in hte last line just before End Sub insert the following line so it will look like this
-----------
WMFileCreate WS
End Sub
-----------
10) SAVE Your production workbook
11) doubleclick on ThisWorkbook of your production workbook
12) Press on Edit Select All in the Menu and in the code right click and press Delete you will endup wit an empty code in Thisworkbook
13) Paste the below code in Thisworkbook that you just deleted. (SELECT ALL right click Choose COPY and paste in ThisWorkbook of your production file.)
Private Sub Workbook_Deactivate()
SaveSetting APP_CATEGORY, APPNAME, "FolderToMonitor", gstFolderToMonitor
SaveSetting APP_CATEGORY, APPNAME, "FolderToTransfer", gstFolderToTransfer
SaveSetting APP_CATEGORY, APPNAME, "FolderWesternUnion", gstFolderWesternUnion
End Sub
Private Sub Workbook_Open()
On Error GoTo errHandler
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
StartPGM = True
gstFolderToMonitor = GetSetting(APP_CATEGORY, APPNAME, "FolderToMonitor", vbNullString)
gstFolderToTransfer = GetSetting(APP_CATEGORY, APPNAME, "FolderToTransfer", vbNullString)
gstFolderWesternUnion = GetSetting(APP_CATEGORY, APPNAME, "FolderWesternUnion", vbNullString)
Set wsVisa = ThisWorkbook.Sheets("Wire-Staging-FBME")
Set wsMain = ThisWorkbook.Sheets("Main")
CRow = 1
wsMain.Range("L1:L1000").ClearContents
wsMain.Range("L" & CRow) = "Workbook Open - gstFolderToMonitor: " & gstFolderToMonitor
wsMain.Range("L" & CRow + 1) = "Workbook Open - gstFolderToTransfer: " & gstFolderToTransfer
wsMain.Range("L" & CRow + 2) = "Workbook Open - gstFolderWesternUnion: " & gstFolderWesternUnion
CRow = CRow + 3
wsVisa.Activate
wsMain.Activate
Exit Sub
errHandler:
If Err = 9 Then
MsgBox ("One of the essential sheets are missing. Pls review and try again")
End
Else
MsgBox (Error(Err))
wsMain.Range("L" & CRow) = "Workbook Open - Error: <" & Error(Err) & ">"
CRow = CRow + 1
Resume Next
End If
End Sub14) SAVE your production workbook.
15) Doubleclick on the sheet MAIN in the left pane of your production file. Choose from the Edit Menu Select All then in the code right click Delete and you will endup with a blank page in the Main code window.
16) SELECT ALL from the below code and right click choose COPY and paste it in the Main Code of your production workbook.
Private Sub Combobox1_Change()
gstFolderToMonitor = ComboBox1.Text
If ComboBox1 <> "" And ComboBox2 <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo1 Change - " & gstFolderToMonitor
CRow = CRow + 1
End Sub
Private Sub ComboBox2_Change()
gstFolderToTransfer = ComboBox2.Text
If ComboBox1 <> "" And ComboBox2 <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo2 Change - " & gstFolderToTransfer
CRow = CRow + 1
End Sub
Private Sub CommandButton1_Click()
'GetEmails
LocateEmails
End Sub
Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub
Private Sub Worksheet_Activate()
On Error GoTo ErrhandlerAct
If StartPGM Then
FillCombo ComboBox1
FillCombo ComboBox2
gstFolderToMonitor = ComboBox1
gstFolderToTransfer = ComboBox2
If gstFolderToMonitor = "" Then
MsgBox ("Please select a Folder to Monitor Emails")
Else
ComboBox1.Text = gstFolderToMonitor
End If
If gstFolderToTransfer = "" Then
MsgBox ("Please select a Folder to Transfer Emails Imported")
Else
ComboBox2.Text = gstFolderToTransfer
End If
If ComboBox1 <> "" And ComboBox2 <> "" And gstFolderToMonitor <> "" And gstFolderToTransfer <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
If gstFolderWesternUnion = vbNullString Then
GetNewFolder
Else
Sheets("Main").CommandButton3.Caption = "Target Export Folder for Western Union: <" & gstFolderWesternUnion & "> ... Activated"
End If
wsMain.Range("L" & CRow) = "Main Activate - gstFolderToMonitor: " & gstFolderToMonitor
wsMain.Range("L" & CRow + 1) = "Main Activate - gstFolderToTransfer: " & gstFolderToTransfer
wsMain.Range("L" & CRow + 2) = "Main Activate - gstFolderWesternUnion: " & gstFolderWesternUnion
CRow = CRow + 3
StartPGM = False
End If
Exit Sub
ErrhandlerAct:
MsgBox (Error(Err))
Resume Next
End Sub17) SAVE your Production workbook.
18) Goto to your Excel sheet and display in both windows sheet Main. Select Developper menu and make sure that for both windows the Design button is clicked.
19) Select the Red label in the present attached file and press shift while holding shift press on the Red button so they are both selected release the shift button and right click (make sure the mouse is over the button) and choose copy
20) click on your production workbook so it get the focus and move the existing buttons if they are there and paste the items you just copied after the transfer combobox like in the attached sheet.
21) click anywhere else in hte Main worksheet so it remove the focus from the command button.
22) doubleclick on the red command button and make sure that the code is:
----------------
Private Sub CommandButton3_Click()
GetNewFolder
End Sub
---------------
The commanbutton should be 3 if it is not then you need to tell me what it is and I will let you know what the change will be.
23) SAVE the production workbook and exit it
24) Exit the attached file without saving it.
25) Try the new production workbook and let me know your feedback.
gowflow
ASKER
Wow! That's quite a chunk of work and code you just put in gowflow!
I'll get to it later today. Thanks. I'll let you know, probably tomorrow am, my time,
how it worked out.
I'll get to it later today. Thanks. I'll let you know, probably tomorrow am, my time,
how it worked out.
No problem take your time
gowflow
gowflow
ASKER
I think I'm following and have done all the way to this direction:
"Select the Red label in the present attached file and press shift while holding shift press on the Red button so they are both selected release the shift button and right click (make sure the mouse is over the button) and choose copy"
What do you mean by Red label? and Red button? Attached is what I have. VisaSpreadsheet17-2011 is my production workbook. I don't have a red anything.
"Select the Red label in the present attached file and press shift while holding shift press on the Red button so they are both selected release the shift button and right click (make sure the mouse is over the button) and choose copy"
What do you mean by Red label? and Red button? Attached is what I have. VisaSpreadsheet17-2011 is my production workbook. I don't have a red anything.
ASKER
It would be very helpful in your instructions to specifically name what file you're referring to. For example, when you state:
"Open the file just created activate macros.
3) from with in the previous file press file/open and Open the attached file (make sure they both don't have the same name)"
What file are you referring to when you say 'just created'? And what file do you mean when you state 'previous file'?
I understand what the 'production' file is. That is my current Visa file I saved with a new name. However, when you are referring to your file just attached, please state the name of it: Visa-20111017. If you are referring to any other file, please be clear.
What I have done thus far is copy the above code snippets and placed them in my production file. Is that correct ? Because it seems I do NOT need your Visa-20111017 file before point#17. Right? If I have done it correctly so far, then I think I can figure out which files you are referring to from 17 on.
"Open the file just created activate macros.
3) from with in the previous file press file/open and Open the attached file (make sure they both don't have the same name)"
What file are you referring to when you say 'just created'? And what file do you mean when you state 'previous file'?
I understand what the 'production' file is. That is my current Visa file I saved with a new name. However, when you are referring to your file just attached, please state the name of it: Visa-20111017. If you are referring to any other file, please be clear.
What I have done thus far is copy the above code snippets and placed them in my production file. Is that correct ? Because it seems I do NOT need your Visa-20111017 file before point#17. Right? If I have done it correctly so far, then I think I can figure out which files you are referring to from 17 on.
ASKER
Ok, it worked, so I must have done it correctly, however there are some issues that I will be getting back to you on. But overall, so far so good. Thank you!
ASKER
The great thing is that it did exactly as requested, but here are some minor issues:
1. Often times the email batch imported highlights both the empty row AND the first row imported in yellow. Just need the empty row between the imported emails highlighted.
2. Even though a MTCN number was not brought in (the sender made a mistake) it still went on with the process of creating a spreadsheet and creating an email, attaching the incomplete spreadsheet. So I need to check it over first, fix any errors, then continue with the automatic process., if possible. Now if I click 'no' it stops the process completely.
3. When updating my production visa sheet, it inputs today's date in any blank cell in Col J and inputs the 'Wutoday's date' in any blank cell of Col P. I'd rather not have this as they are intended to be blank and I do have other rows that are blank by design. I would say update Col J and Col P with those values IF there is a value in Col D - the MTCN# column.
4, There must be values in cols A through G and Col M and WUtoday's date value in Col P before I can email the spreadsheet. And as mentioned, I really need to double check to make sure everything was imported correctly from the email before it gets sent to Jozsef.
Thank you!
1. Often times the email batch imported highlights both the empty row AND the first row imported in yellow. Just need the empty row between the imported emails highlighted.
2. Even though a MTCN number was not brought in (the sender made a mistake) it still went on with the process of creating a spreadsheet and creating an email, attaching the incomplete spreadsheet. So I need to check it over first, fix any errors, then continue with the automatic process., if possible. Now if I click 'no' it stops the process completely.
3. When updating my production visa sheet, it inputs today's date in any blank cell in Col J and inputs the 'Wutoday's date' in any blank cell of Col P. I'd rather not have this as they are intended to be blank and I do have other rows that are blank by design. I would say update Col J and Col P with those values IF there is a value in Col D - the MTCN# column.
4, There must be values in cols A through G and Col M and WUtoday's date value in Col P before I can email the spreadsheet. And as mentioned, I really need to double check to make sure everything was imported correctly from the email before it gets sent to Jozsef.
Thank you!
1. is related to the previous question correct ? it is not within this question. If correct then I need to know in what cases this happens like a sample of the emails or a snapshot so I can figure out why htis is happeneing. I recall it did happen with me but as we did this part sometime ago I forgot about it now.
2. What do you mean ?? there are no lines to export and then you got the Excel created ? I guess its correct will need to chk if no record to export then to message something and prevent the creation of excel and email. If this is not what you meant pls clarify.
3. I did that due to your request and was a aware when I saw the file in hand especially the first couple of 100 rows had noting in J and it went putting the date and exported them ... Will fix it so it update Col J and P if D has a value. HOWEVER
I remind you the intial post: Make an Excel file with all records that have no date in Col J, so now it will be No date in Col J + value in Col D (this should eliminate all the blank rows that you had there by design) your left now with one issue which is the yellow lines that have no value in Col J and no Value in Col D therefore they will not be imported !!!! I will modify the importwesternunion emails so I can trap these yellow lines so we can export them and identify them.
4. I know that when I designed it this was a challenge as you are prompt to continue with the export or stop and don't have time to check the file and make corrections. Let me think of a way to allow you for checking/fixing before generating the email.
gowflow
ASKER
1. Yes, from previous question. I'll investigate it further and get back to you.
2. What I mean is that in place of 'MTCN#' one entry in an email had 'Amount' so the MTCN number was not brought over. (Of course. Why did they do that?) And, things like this will happen where data will not import because of the emailer's error.
3. Sounds good
4. Ok. Thank you.
2. What I mean is that in place of 'MTCN#' one entry in an email had 'Amount' so the MTCN number was not brought over. (Of course. Why did they do that?) And, things like this will happen where data will not import because of the emailer's error.
3. Sounds good
4. Ok. Thank you.
2. now in this case the item will not be exported although it shows in the file with MTCN# empty unless if you post the number manually then it will be imported. Is it ok this way ?
gowflow
gowflow
ASKER
Yes, there will be times when I just have to import something manually, but where I'd like that to be done is BEFORE it creates the new spreadsheet - if possible. But of course, definitely before it is attached to an email
ok fine here it is (let me be careful this time !!!)
The way it work
We have now 3 steps and each one is independent of the other and is activated by a button. like in the pic below.
Step 1 - Import WU Emails
Step 2 - Generate WU file
Step 3 - Generate Email and Update 'WU-Staging-FBME'
When you run a step and it completes you can check the coresponding data and make corrections for the next step. When you run Step 1 it will import the data form Emails to 'WU-Staging-FBME' and stops there. You then go to the sheet and check all the missing items and update manually or delete whatever and once done you move to Step 2 that will Generate the file from the existing modified data in 'WU-Staging-FBME'. Once generated the procedure stops leaving the file gerated open for you to check that all is ok. You may do alterations modifications to this file and save it. Then when you activate Step 3 it will tell you that you have a pending file not emailed with its name and proceed to create the email and update 'WU-Staging-FBME'. and the circle is completed for you to start a new circle. There are checks that will prevent you from sending a same file twice by email as it will keep track of the last file sent.
Here is how to IMPLEMENT (will try to keep it simple and will not bother you with an attached file !!!
1) Save your latest Visa file onto a new name and open it.
2) goto developper Visual Basic and doubleclick on module1
3) Choose to view 1 sub at a time by clicking on the left lower icon
4) Select the following sub and delete
Sub ImportWesternUnion()
Sub WMFileCreate
5) SAVE the workbook
6) SELECT ALL from the below code right click in the code choose COPY and paste in module1 after any End Sub.
Sub ImportWesternUnion()
Dim WS As Worksheet
Dim objOutlook As Object
Dim rng As Range, RngCardHolder As Range
Dim arrRows() As String
Dim arrRow() As String
Dim elem As Variant
Dim FMonitor, FTransfer
Dim FoundDivider As Boolean, FirstItemInMail As Boolean, StartDivider As Boolean
Dim CardNumber As String, CardHolder As String, TmpCardHolder As String
Dim SenderEmail As String
Dim Divider As String
Dim I As Long, J As Long, K As Long, L As Long
Dim C, FirstAddress, Items
Dim TmpAmount As String
Dim Fields As String, Possibility As String
Dim LenItem As Long, ColJRow As Long, ColARow As Long
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set WS = Sheets("WU-Staging-FBME")
FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Import Western Union - FMonitor: " & objFolderToMonitor
CRow = CRow + 1
'Disabled in this procedure as user do not want to move emails.
'FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
'If Not SetTransferFolder(FTransfer) Then Exit Sub
'wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
'CRow = CRow + 1
Dim VItem As Outlook.MailItem
Set VisaItems = objFolderToMonitor.Items.Restrict("[Subject] <> 'Payment Received'")
VisaItems.Sort "receivedtime", False
'Setting Value of I depending on last item in Col J
ColJRow = WS.Range("J:J").Rows(WS.Range("J:J").Rows.Count).End(xlUp).Row
ColARow = WS.Range("A:A").Rows(WS.Range("A:A").Rows.Count).End(xlUp).Row
WS.Range("D:D").NumberFormat = "@"
If ColARow = ColJRow Then
I = 1
Else
I = WS.Cells(ColARow, 1) + 1
End If
Application.EnableEvents = False
For Each VItem In VisaItems
wsMain.Range("L" & CRow) = "Import Western Union - Items: " & I & " " & VItem.SenderEmailAddress & " " & VItem
CRow = CRow + 1
Set objMail = VItem
' use Instr here to check subject or body
'MsgBox objMail.Subject
Body = objMail.Body
ETime = objMail.ReceivedTime
CardNumber = ""
FoundDivider = False
StartDivider = False
FirstItemInMail = True
SenderEmail = objMail.SenderEmailAddress
'Split Email address
Select Case Trim(UCase(SenderEmail))
Case "WHITE@SECURENYM.NET"
CardHolder = "Jen" & Format(ETime, "mmddyy")
Case "BLIZZARD1980@HOTMAIL.COM"
CardHolder = "Adam" & Format(ETime, "mmddyy")
Case "KONG@SECURENYM.NET"
CardHolder = "Shawn" & Format(ETime, "mmddyy")
Case "INFO@HOLMSENTREPRISES.COM"
CardHolder = "Holms" & Format(ETime, "mmddyy")
Case Else
CardHolder = SenderEmail & Format(ETime, "mmddyy")
End Select
'Check to see if Combination CardHolder + Col C date already exist then increment CardHolder by 1
With WS.Range("M:M")
TmpCardHolder = CardHolder
K = 2
Do
Set C = .Find(TmpCardHolder, LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
TmpCardHolder = CardHolder & "-" & Format(K)
K = K + 1
End If
Loop Until C Is Nothing
CardHolder = TmpCardHolder
End With
If InStr(1, UCase(Body), "MTCN", vbTextCompare) > 0 Then
If rng Is Nothing Then
Set rng = WS.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
rng.Offset(1, 0).EntireRow.Insert
WS.Range(rng.Offset(0, -1), rng.Offset(0, 39)).Interior.ColorIndex = 6
'Made to trap yellow lines for Export Email
rng.Offset(0, 2).Value = " "
Else
rng.Offset(1, 0).EntireRow.Insert
WS.Range(rng.Offset(1, -1), rng.Offset(1, 39)).Interior.ColorIndex = 6
'Made to trap yellow lines for Export Email
rng.Offset(1, 2).Value = " "
Set rng = rng.Offset(1, 0)
End If
arrRows = Split(Body, vbCrLf, , vbTextCompare)
For Each elem In arrRows
If InStr(1, elem, "Ashleigh Walck") > 0 Then
a = 1
End If
'Spot Card Number as 'CARD #'
If InStr(1, UCase(elem), "CARD #", vbTextCompare) > 0 And CardNumber = "" Then
CardNumber = Trim(Mid(elem, InStr(1, UCase(elem), "CARD #", vbTextCompare) + 6))
If Not IsNumeric(CardNumber) Then
TmpCardNumber = ""
For J = 1 To Len(CardNumber)
If IsNumeric(Mid(CardNumber, J, 1)) Then TmpCardNumber = TmpCardNumber & Mid(CardNumber, J, 1)
Next J
CardNumber = TmpCardNumber
End If
'To prevent other routines to interact
elem = ""
End If
'Spot when block does not have semicolumn as divider in semicolumn ':' or else use space ' '
If Left(Trim(elem), 1) <> "-" And Left(Trim(elem), 1) <> "=" And Left(Trim(elem), 1) <> "*" And Trim(elem) <> "" Then
If InStr(elem, ":") > 0 Then
If InStr(InStr(elem, ":") + 1, elem, ":") > 0 Then
Divider = " "
Else
Divider = ":"
End If
Else
If InStr(elem, ";") > 0 Then
If InStr(InStr(elem, ";") + 1, elem, ";") > 0 Then
Divider = " "
Else
Divider = ";"
End If
Else
If InStr(elem, " ") > 0 Then
Divider = " "
Else
Divider = ""
End If
End If
End If
End If
'Spot beginning of Items
If Left(elem, 1) = "-" Or Left(elem, 1) = "=" Then
FoundDivider = True
StartDivider = True
End If
'Spot Dividers in semicolumn ':' or else use space ' '
LenItem = 0
Possibility = ""
Fields = "MTCN|MTCN#|MCTN|MCTN#|MTCN #|MTC#|MTCN;"
Items = Split(Fields, "|")
For L = 0 To UBound(Items)
If InStr(1, elem, Items(L), vbTextCompare) > 0 Then
If Len(Items(L)) > LenItem Then
Possibility = Items(L)
LenItem = Len(Items(L))
End If
End If
Next L
If Possibility <> "" Then
If Not FoundDivider Then FoundDivider = True
If Divider = "" Then
Divider = " "
elem = Possibility & Divider & Mid(elem, Len(Possibility) + 1)
End If
End If
If InStr(elem, Divider) > 0 And Divider <> "" Then
arrRow = Split(elem, Divider)
'Select Case Trim(UCase(CStr(arrRow(0))))
' Case "MTCN", "MTCN#", "MCTN", "MCTN#", "MTCN #", "MTC#", "MTCN;"
' If Not FoundDivider Then FoundDivider = True
'
'End Select
If FoundDivider Then
'Delete Row if no values
If WS.Range(rng.Offset(0, -1), rng.Offset(0, 39)).Interior.ColorIndex <> 6 And rng.Offset(0, 0).Value = "" And rng.Offset(0, 2).Value = "" And rng.Offset(0, 3).Value = "" And rng.Offset(0, 5).Value = "" Then
RngDeletd = WS.Cells(rng.Row - 1, rng.Column).Address
WS.Range(rng.Row & ":" & rng.Row).EntireRow.Delete
Set rng = WS.Range(RngDeletd)
I = I - 1
End If
Set rng = rng.Offset(1, 0)
rng.Offset(0, 1) = Format(ETime, "dd mmm yyyy")
rng.Offset(0, -1) = I
rng.Offset(0, 11) = CardHolder
If FirstItemInMail Then
rng.Offset(0, 16) = CardNumber
If Left(CardNumber, 1) = "4" Then rng.Offset(0, 17) = "EUR"
If Left(CardNumber, 1) = "5" Then rng.Offset(0, 17) = "USD"
FirstItemInMail = False
End If
wsMain.Range("L" & CRow) = " Item: " & I & " " & VItem.SenderEmailAddress
CRow = CRow + 1
I = I + 1
FoundDivider = False
End If
If Divider = " " And (CardNumber <> "" Or StartDivider = True) Then
X = UpdateItemFound(rng, elem)
Else
Select Case Trim(UCase(CStr(arrRow(0))))
Case "MTCN", "MTCN#", "MCTN", "MCTN#", "MTCN #", "MTC#", "MTCN;"
'Fix to importing MCTN with all characters including leading and trailing zeros
If Trim(arrRow(1)) <> "" Then
rng.Offset(0, 2) = Trim(Format(arrRow(1), "@"))
Else
If UBound(arrRow) > 1 Then
rng.Offset(0, 2) = Trim(Format(arrRow(2), "@"))
End If
End If
Case "RECEIVER", "RECIEVER INFO", "RECEIVER NAME", "RECIEVER", "RECEVIER", "RECIVER", "RCVR"
rng = Trim(arrRow(1))
Case "SENDER LOCATION", "LOCATION", "SENDER'S W.U. LOCATION", "SENDER'S W.U. LOCATION(CITY & STATE)", "SENDERS W.U. LOCATION", "SENDER'S W.U. LOCATION (CITY AND STATE)", "SENDER'S LOCATION", "SENDER INFO", "SENDER LOC ", "W U LOCATION", "SENDER WU LOCATION", "SEND LOC ", "SENDER LOC", "SENDER LOC", "SENDERS WU LOCATIONS", "SENDERS W.U'S LOCATION", "SENDERS W/U LOCATION", "ADDRESS", "SENDERS W.U. LOCATION", "SENDERS LOCATION", "SENDER WU LOCATION", "SENDER LOCATION SENT", "SENDER W/U LOCATION", "SENDER W.U. LOCATION", "W.U. LOCATION", "W/U LOCATION", "W.U. LOCTION", "SENDER LOC.", "AMT SENT", "SENT FROM", "WU LOCATION", "LOCATION.", "LOC.", "SENDING WU LOCATION", "CITY"
rng.Offset(0, 4) = Trim(arrRow(1))
Case "AMOUNT", "AMT", "AMOUNT SENT", "TOTAL", "TOTAL AMOUNT", "AOUNT", "MOUNT", "AMNT", "AMOUNT $"
'Fix to importing amount as a number formated as $currency with double digits and
'Red if negatives
If Not IsNumeric(arrRow(1)) Then
TmpAmount = ""
For J = 1 To Len(elem)
If IsNumeric(Mid(elem, J, 1)) Or Mid(elem, J, 1) = "." Then TmpAmount = TmpAmount & Mid(elem, J, 1)
Next J
arrRow(1) = TmpAmount
End If
If arrRow(1) <> "" Then rng.Offset(0, 5) = CDbl(arrRow(1))
rng.Offset(0, 5).NumberFormat = "$#,##0.00;[Red]($#,##0.00)"
Case "SENDER", "ENDER"
rng.Offset(0, 3) = Trim(arrRow(1))
Case Else
End Select
End If
End If
Next elem
End If
Next VItem
Application.EnableEvents = True
'WS.UsedRange.EntireColumn.AutoFit
X = MsgBox("Total of " & I & " Western Union detailed transfer imported successfully." & Chr(10) _
& "Please check data in sheet 'WU-Staging-FBME' and make necessary corrections if any before proceeding to Step 2 - [Generate WU File]", vbInformation, "Step 1 - Import WU Emails")
End Sub
Sub WMFileCreate(WS As Worksheet)
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow As Long, I As Long, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String
Dim X
If gstFolderWesternUnion = "" Then
MsgBox ("You need to select a destination folder to store the western Union files created. Please go to Sheet 'Main' and select a folder before proceeding further.")
Exit Sub
Else
If MsgBox("This process will create a new workbook with all records in sheet 'WU-Staging-FBME' that have NO date in Col J." & Chr(10) & Chr(10) _
& "Are you ready to start this process ?", vbQuestion + vbYesNo, "Step 2 - Generate WU File ") = vbYes Then
J = 1
'First Criteria Col J = ''
WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
'Second Criteria Col D <>''
WS.UsedRange.AutoFilter Field:=4, Criteria1:="=" & "*"
MaxRow = WS.UsedRange.Rows.Count
Set NewWb = Workbooks.Add
Set NewWS = NewWb.Sheets("Sheet1")
NewWS.Name = "WU" & Format(Now, "mm-dd-yyyy")
'Visa - WUSept9-11.xls'
NewWb.SaveAs Filename:=gstFolderWesternUnion & "WU" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
NewWorkB = NewWb.Name
For I = 1 To MaxRow
If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
WS.Range("A" & I & ":P" & I).Copy NewWS.Cells(J, 1)
J = J + 1
End If
Next I
NewWS.Range("Q:Z").EntireColumn.Delete
'WS.ShowAllData
'WS.AutoFilterMode = False
'processCC NewWS
With NewWS.Columns("A:P")
.EntireColumn.AutoFit
.HorizontalAlignment = xlLeft
End With
Application.DisplayAlerts = False
For Each WSS In NewWb.Worksheets
If WSS.Name <> NewWS.Name Then WSS.Delete
Next WSS
NewWb.Save
Application.DisplayAlerts = True
MaxRow = NewWS.UsedRange.Rows.Count
If MaxRow > 2 Then
gstGenerateWUName = NewWb.FullName
gstGenerateWUEmail = ""
X = MsgBox("Workbook: '" & NewWorkB & "' has been created successfully. Please check workbook to ensure all data is accurate. After all modifications done please ensure file is saved to proceed to Next Step 3 - [ Generate Email & Update 'WU-Staging-FBME']", vbInformation, "Step 2 - Generate WU File")
Else
Application.DisplayAlerts = False
Kill NewWb.FullName
Application.DisplayAlerts = True
gstGenerateWUName = ""
gstGenerateWUEmail = ""
MsgBox ("No Records were found ! nothing to Export.")
End If
WS.ShowAllData
WS.AutoFilterMode = False
End If
End If
End Sub
Sub WUEmailCreate(WS As Worksheet, NewWorkB As String)
Dim NewWb As Workbook
Dim NewWS As Worksheet
Dim MaxRow As Long, I As Long, J As Long
If MsgBox("Are you ready to proceed with Email Creation for file '" & NewWorkB & "' and Update sheet 'WU-Staging-FBME' with today's date in Col J ?", vbQuestion + vbYesNo, "Step 3 - Generate Email & Update 'WU-Staging-FBME'") = vbYes Then
Set NewWb = Workbooks.Open(NewWorkB)
Set NewWS = ActiveSheet
J = 1
'First Criteria Col J = ''
WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
'Second Criteria Col D <>''
WS.UsedRange.AutoFilter Field:=4, Criteria1:="=" & "*"
MaxRow = WS.UsedRange.Rows.Count
For I = 2 To MaxRow
If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
WS.Range("J" & I) = DateValue(Now)
WS.Range("P" & I) = "WU" & Format(Now, "Mmmdd-yy")
J = J + 1
End If
Next I
WS.ShowAllData
WS.AutoFilterMode = False
SendEmail NewWb.FullName
gstGenerateWUEmail = NewWb.FullName
Else
MsgBox ("Request Canceled by user, No Email created and Col J and P not updated in 'WU-Staging-FBME'")
End If
End Sub7) SAVE the workbook
8) In module1 on the right top combobox select the first item Declaration select all the declaration section and delete the code. Once deleted it will display the first Sub. Click again on the right top combobox and select again Declaration you will see a white page. Paste the below code in this white page
Global Const APP_CATEGORY = "Software JG"
Global Const APPNAME = "ImportEmails"
Global wsVisa As Worksheet
Global wsMain As Worksheet
Global myolApp As Outlook.Application
Global gstFolderToMonitor As String
Global gstFolderToTransfer As String
Global gstFolderWesternUnion As String
Global gstGenerateWUName As String
Global gstGenerateWUEmail As String
Global objOutlook As New Outlook.Application
Global objNameSpace As Outlook.Namespace
Global objFolders As Outlook.Folders
Global objFolder As MAPIFolder
Global InboxFolder As MAPIFolder
Global objFolderToMonitor As MAPIFolder
Global objFolderToTransfer As MAPIFolder
Global VisaItems As Outlook.Items
Global objMail As Outlook.MailItem
Global StartPGM As Boolean
Global CRow As Long9) SAVE the workbook.
10) Doubleclick on Thisworkbook in the left pane and select all the code there (edit/select all) and delete the code there and paste the below code in the white area.
Private Sub Workbook_Deactivate() 'gstGenerateWUName
SaveSetting APP_CATEGORY, APPNAME, "FolderToMonitor", gstFolderToMonitor
SaveSetting APP_CATEGORY, APPNAME, "FolderToTransfer", gstFolderToTransfer
SaveSetting APP_CATEGORY, APPNAME, "FolderWesternUnion", gstFolderWesternUnion
SaveSetting APP_CATEGORY, APPNAME, "GenerateWUName", gstGenerateWUName
SaveSetting APP_CATEGORY, APPNAME, "GenerateWUEmail", gstGenerateWUEmail
End Sub
Private Sub Workbook_Open()
On Error GoTo errHandler
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
StartPGM = True
gstFolderToMonitor = GetSetting(APP_CATEGORY, APPNAME, "FolderToMonitor", vbNullString)
gstFolderToTransfer = GetSetting(APP_CATEGORY, APPNAME, "FolderToTransfer", vbNullString)
gstFolderWesternUnion = GetSetting(APP_CATEGORY, APPNAME, "FolderWesternUnion", vbNullString)
gstGenerateWUName = GetSetting(APP_CATEGORY, APPNAME, "GenerateWUName", vbNullString)
gstGenerateWUEmail = GetSetting(APP_CATEGORY, APPNAME, "GenerateWUEmail", vbNullString)
Set wsVisa = ThisWorkbook.Sheets("Wire-Staging-FBME")
Set wsMain = ThisWorkbook.Sheets("Main")
CRow = 1
wsMain.Range("L1:L1000").ClearContents
wsMain.Range("L" & CRow) = "Workbook Open - gstFolderToMonitor: " & gstFolderToMonitor
wsMain.Range("L" & CRow + 1) = "Workbook Open - gstFolderToTransfer: " & gstFolderToTransfer
wsMain.Range("L" & CRow + 2) = "Workbook Open - gstFolderWesternUnion: " & gstFolderWesternUnion
wsMain.Range("L" & CRow + 3) = "Workbook Open - Last GenerateWUName: " & gstGenerateWUName
wsMain.Range("L" & CRow + 4) = "Workbook Open - Last GenerateWUEmail: " & gstGenerateWUEmail
CRow = CRow + 5
wsVisa.Activate
wsMain.Activate
Exit Sub
errHandler:
If Err = 9 Then
MsgBox ("One of the essential sheets are missing. Pls review and try again")
End
Else
MsgBox (Error(Err))
wsMain.Range("L" & CRow) = "Workbook Open - Error: <" & Error(Err) & ">"
CRow = CRow + 1
Resume Next
End If
End Sub11) SAVE the workbook
12) Doubleclick on Main and select the whole code and delete it and paste in the white area the below code.
Private Sub Combobox1_Change()
gstFolderToMonitor = ComboBox1.Text
If ComboBox1 <> "" And ComboBox2 <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo1 Change - " & gstFolderToMonitor
CRow = CRow + 1
End Sub
Private Sub ComboBox2_Change()
gstFolderToTransfer = ComboBox2.Text
If ComboBox1 <> "" And ComboBox2 <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo2 Change - " & gstFolderToTransfer
CRow = CRow + 1
End Sub
Private Sub CommandButton1_Click()
'GetEmails
LocateEmails
End Sub
Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub
Private Sub CommandButton3_Click()
GetNewFolder
End Sub
Private Sub CommandButton4_Click()
WMFileCreate Sheets("WU-Staging-FBME")
End Sub
Private Sub CommandButton5_Click()
If gstGenerateWUName = "" Then
MsgBox ("You should Run command [Generate WU File] first, as no file has been generated yet.")
Else
If gstGenerateWUName = gstGenerateWUEmail Then
MsgBox ("File : '" & gstGenerateWUEmail & "' has already been emailed. You should Run command [Generate WU File] to create a new file.")
Else
If gstGenerateWUName <> "" And gstGenerateWUEmail = "" Then
WUEmailCreate Sheets("WU-Staging-FBME"), gstGenerateWUName
End If
End If
End If
End Sub
Private Sub Worksheet_Activate()
On Error GoTo ErrhandlerAct
If StartPGM Then
FillCombo ComboBox1
FillCombo ComboBox2
gstFolderToMonitor = ComboBox1
gstFolderToTransfer = ComboBox2
If gstFolderToMonitor = "" Then
MsgBox ("Please select a Folder to Monitor Emails")
Else
ComboBox1.Text = gstFolderToMonitor
End If
If gstFolderToTransfer = "" Then
MsgBox ("Please select a Folder to Transfer Emails Imported")
Else
ComboBox2.Text = gstFolderToTransfer
End If
If ComboBox1 <> "" And ComboBox2 <> "" And gstFolderToMonitor <> "" And gstFolderToTransfer <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
If gstFolderWesternUnion = vbNullString Then
GetNewFolder
Else
Sheets("Main").CommandButton3.Caption = "Target Export Folder for Western Union: <" & gstFolderWesternUnion & "> ... Activated"
End If
If gstGenerateWUName <> gstGenerateWUEmail Then
MsgBox ("Please note that File : '" & gstGenerateWUName & "' has been created, however not Emailed." & Chr(10) & Chr(10) _
& "You should proceed to select [Generate Email & Update 'WU-Staging-FBME'] button to Email the created file." & Chr(10) & Chr(10) _
& "You may at any time, select [Generate WU File] to build a new file for Export")
End If
wsMain.Range("L" & CRow) = "Main Activate - gstFolderToMonitor: " & gstFolderToMonitor
wsMain.Range("L" & CRow + 1) = "Main Activate - gstFolderToTransfer: " & gstFolderToTransfer
wsMain.Range("L" & CRow + 2) = "Main Activate - gstFolderWesternUnion: " & gstFolderWesternUnion
CRow = CRow + 3
StartPGM = False
End If
Exit Sub
ErrhandlerAct:
MsgBox (Error(Err))
Resume Next
End Sub13) SAVE the workbook
14) We need now to create 3 buttons like in the first attached image. to do this goto sheet Main make sure in menu developper the Design icon is clicked, then right click on the purple button called Western Union Imports choose copy and paste it twice there so you will have 3 buttons. Put the first button on top the next one created underneith and the last one at the end. Right click each one and select property and change their caption to fit the Image change also the color if you want to yellow (background) and don't forget to change the foreground to black it was initially white.
now make sure that
CommanButton2 is: 1 - Import WU Emails
CommanButton4 is: 2 - Generate WU File
CommanButton5 is: 3 - Generate Email & Update 'WU-Staging-FBME'
Once done SAVE the workbook
15) doubleclik on each button and make sure the below code is already there
Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub
Private Sub CommandButton4_Click()
WMFileCreate Sheets("WU-Staging-FBME")
End Sub
Private Sub CommandButton5_Click()
If gstGenerateWUName = "" Then
MsgBox ("You should Run command [Generate WU File] first, as no file has been generated yet.")
Else
If gstGenerateWUName = gstGenerateWUEmail Then
MsgBox ("File : '" & gstGenerateWUEmail & "' has already been emailed. You should Run command [Generate WU File] to create a new file.")
Else
If gstGenerateWUName <> "" And gstGenerateWUEmail = "" Then
WUEmailCreate Sheets("WU-Staging-FBME"), gstGenerateWUName
End If
End If
End If
End Sub16) SAVE the workbook EXIT start it again and try it
Let me know your comments.
gowflow
ASKER
Seemed to work perfectly on a batch I had come in, except it did not input 'WuOct18-11" (for today's date) in Col P of the production spreadsheet nor in the created spreadsheet.
ASKER
Hmmmm..... Maybe it did put in the WuOct18-11 after the email is created? But it still is putting values in the blank rows in Col J and P, which should remain blank.
Well when you activate stepp 3 this is where it updates Col J and P unfortunately you will have to live with the yellow columns beeing flaged in J and P although it does not make sence but also importing them to excel when they are blank also does not make sence so to be consequent and to have the file keep integrity you will have to choose:
Between
1) not importing the yellow line hence Col J and P will not be updated
and
2) Importing the yellow lines hence updating the date in Col J and P will be done
Rgds/gowflow
Between
1) not importing the yellow line hence Col J and P will not be updated
and
2) Importing the yellow lines hence updating the date in Col J and P will be done
Rgds/gowflow
ASKER
I think I can get around values being put in the blank rows by just putting some value in them before running the process. One thing it is not doing that needs to be done: With the created spreadsheet it is not imputting the WUToday'sDate value in Col P (and thus the emailed spreadsheet) maybe because it isn't inserting that value in the production spreadsheet before the new spreadsheet is created.
With the created spreadsheet it is not imputting the WUToday'sDate value in Col P (and thus the emailed spreadsheet)
>>> For sure it is not putting values in Col J and P Should it ??? Was under the impression htat only Via file should be updated wit the values.
I quote your post
3. For each row Where there is no date in Col J in 'WU-Staging-FBME', copy the values from Cols: a through p and paste into the new spreadsheet, including the yellow highlighted blank rows
no wher eit says: Import the rows that have no value in Col J and in the Excel spreadsheet created make the col J = today's date and Col P = WU + todays date . It only says:
2. For each row Where there is no date in Col J in 'WU-Staging-FBME', in Col P of 'WU-Staging-FBME' input: 'Wutoday's date'. (Example: WuOct17-11)
gowflow
>>> For sure it is not putting values in Col J and P Should it ??? Was under the impression htat only Via file should be updated wit the values.
I quote your post
3. For each row Where there is no date in Col J in 'WU-Staging-FBME', copy the values from Cols: a through p and paste into the new spreadsheet, including the yellow highlighted blank rows
no wher eit says: Import the rows that have no value in Col J and in the Excel spreadsheet created make the col J = today's date and Col P = WU + todays date . It only says:
2. For each row Where there is no date in Col J in 'WU-Staging-FBME', in Col P of 'WU-Staging-FBME' input: 'Wutoday's date'. (Example: WuOct17-11)
gowflow
ASKER
Sorry, I'm not following your above post.
What I need to have is the newly created sheet (the sheet that is also emailed) have WUtoday'sDate inserted for all rows populated in Col P
What I need to have is the newly created sheet (the sheet that is also emailed) have WUtoday'sDate inserted for all rows populated in Col P
what about Col J ? the date as well ?
gowflow
gowflow
ASKER
Col J does NOT get input into the created spreadsheet, only into the production sheet as Col J's purpose is to tell me that an email (the email created) was sent to Josef on the date indicated. So Col J in the created spreadsheet remains blank. Thank you!
so to summ it up what are the problems remaining:
1) to put in Col P of the created spreadsheet WUtoday's date
2) Not to put anything in yellow columns in WU-Staging-FBME Col J and Col P
Anything else ?
I presume also Yellow lines in Excel created not to have a date in Col P right ?
pls confirm
gowflow
1) to put in Col P of the created spreadsheet WUtoday's date
2) Not to put anything in yellow columns in WU-Staging-FBME Col J and Col P
Anything else ?
I presume also Yellow lines in Excel created not to have a date in Col P right ?
pls confirm
gowflow
ASKER
1. yes
2. Not to put anything in yellow ROWS or ANY empty row (empty could be defined as nothing in Col C.)
And yes, the yellow rows should contain nothing but yellow. No data.
2. Not to put anything in yellow ROWS or ANY empty row (empty could be defined as nothing in Col C.)
And yes, the yellow rows should contain nothing but yellow. No data.
Your story is definitvely challenging ! good common sence for yellow but not same logic when it comes to Export ... Export where there is data but also blank rows ... that are yellow and then put data where there is data but not the yellow ... anyway
Will see what I can come up with !! and for sure not matter what I do not accept as an answer ... if you can't do it don't worry forget about it .. I will do it manually !!! These kind of answers I take as an insult to my intelligence !
When I developp it it has to work EXACTLY like the customer wants ... or else it is not a solution !
gowflow
Will see what I can come up with !! and for sure not matter what I do not accept as an answer ... if you can't do it don't worry forget about it .. I will do it manually !!! These kind of answers I take as an insult to my intelligence !
When I developp it it has to work EXACTLY like the customer wants ... or else it is not a solution !
gowflow
ASKER
I appreciate your unwavering determination to excellence, gowflow. Any slight to your intelligence is completely unintended because I view you as a genius in this field, far above my capability to do what I'm hoping to have done - and I thank you for it.
wow am overwhelmed !!! no worry I don't mean any harm to oyur comments but sometimes - and its quite natural - not all people hv the same determination to acheive the desired result and I see this everyday in my work where my clients sometimes seeing that some issues are tough to be resolved say: its ok I'll do it manually anyway its not a big issue ...
One of them is:
The challenge we had and still ur having for the moving of emails (don't know for some reason we still bump on this one)
and also when we were coloring green and red and at some point seeing that it was getting green but not red u said ... don't worry as long as etc ...
etc ....
its these change of course due to difficulties (temeporary I call them) that make people quit or other change course that make me more amore resilient to find the solution !!!! Its like the pinch of adrenalin that keeps me going !!!
too much bla bla let me go back to producing !
gowflow
One of them is:
The challenge we had and still ur having for the moving of emails (don't know for some reason we still bump on this one)
and also when we were coloring green and red and at some point seeing that it was getting green but not red u said ... don't worry as long as etc ...
etc ....
its these change of course due to difficulties (temeporary I call them) that make people quit or other change course that make me more amore resilient to find the solution !!!! Its like the pinch of adrenalin that keeps me going !!!
too much bla bla let me go back to producing !
gowflow
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Tried it once and seemed to work, however there was one strange changing of the value of an amount (the label was far from correct so maybe that caused it), but will test it again tomorrow and get back to you. Thank you
could be. ok will wait to see results of ur tests.
gowflow
gowflow
ASKER
gowflow's the best. He nailed yet another!
we still have a number to go gowflow, if you're willing, continuing on with the next part to this Western Union process and also doing for the Visa email (highlighting the processed and unprocessed) as we did for the Mastercard emails - and it is that I will submit next to get it out of the way.
we still have a number to go gowflow, if you're willing, continuing on with the next part to this Western Union process and also doing for the Visa email (highlighting the processed and unprocessed) as we did for the Mastercard emails - and it is that I will submit next to get it out of the way.
pls confirm or ellaborate
gowflow