Need help in saving file which macro download

Closed
Report
-
 hari -
Hello,


I have a macro which login to one of my site and download a file based on the no what the macro picks up from the excel file. While doing this its takes the default name of the file. I need code which can change the file name in save as option.
In the script where I have highlighted is the place the save as window open and wait for 40 sec and then save with file default file name.
I need the macro to save the file with use the same no what it used to download the file. For this I need to change the file name in Save as option.
Can any one help me with this.

Sub SU()
Application.DisplayAlerts = False
Const gfisregister As String = "https://gfis.iweb.ey.com/gfis/home.nsf/AMRegion"
Const WIP As String = "http://gfisclientengsummary.iweb.ey.com/GFIS/DDBSE.nsf/head?OpenForm&SRV=CN=GFISWEB3/OU=WSVR/O=EYGFIS&DB=GFIS/USA/CES/CESPUS325.NSF&TY=SRCH&KEY=CESP"
UserName = Range("d60").Value
Password = Range("d62").Value
Eng = ActiveCell.Value
Const url As String = "http://gfisclientengsummary.iweb.ey.com/GFIS/DDBSE.nsf/searchCESP?openform&OpenForm&SRV=CN=GFISWEB3/OU=WSVR/O=EYGFIS&DB=GFIS/USA/CES/CESPUS061.NSF&TY=SRCH&KEY=CESP"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True



With ie
.navigate gfisregister 'address of log in page
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop

'this information is specific to the web page
With .Document.forms(0)
.UserName.Value = UserName
.Password.Value = Password
.submit
End With
300
End With



For i = 1 To 50
On Error Resume Next
Eng = ActiveCell.Value
Dim intCount As Integer
For intCount = 3 To 1 Step -1
lblTimer.Caption = CStr(intCount)
Application.Wait Now + TimeValue("00:00:01")
Next intCount
lblTimer.Caption = "0"


If ActiveCell.Value = Empty Then
Call SendKeys("%{F4}")
With ie
.navigate WIP
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
Call SendKeys("%{F4}")
GoTo 305
End If

With ie
.navigate WIP
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Document.frames.Item(0).Document.forms(1).sq(5).Value = Eng
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop

.Document.frames.Item(0).Document.forms(1).sq(5).Focus

Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
For intCount = 3 To 1 Step -1
lblTimer.Caption = CStr(intCount)
Application.Wait Now + TimeValue("00:00:01")
Next intCount
lblTimer.Caption = "0"
Call SendKeys(vbCrLf)



Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop


ie.Document.frames.Item(0).Document.forms(0).sdoc.Click


If ie.Document.frames.Item(0).Document.forms(0).sdoc.Checked = False Then
i = i + 1
ActiveCell.Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

GoTo 301

Else:
'do nothing
End If



For intCount = 15 To 1 Step -1
lblTimer.Caption = CStr(intCount)
Application.Wait Now + TimeValue("00:00:01")
Next intCount
lblTimer.Caption = "0"
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Document.parentWindow.execScript ("downExcel('WIP')"), "javascript"

Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop


For i8ntCount = 40 To 1 Step -1
lblTimer.Caption = CStr(intCount)
Application.Wait Now + TimeValue("00:00:01")
Next intCount
lblTimer.Caption = "0"

Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Call SendKeys("%(S)")

Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop

For intCount = 15 To 1 Step -1
lblTimer.Caption = CStr(intCount)
Application.Wait Now + TimeValue("00:00:01")
Next intCount
lblTimer.Caption = "0"

Call SendKeys("%{F4}")

'.document.frames.Item(0).document.forms(1).submit
End With

301

NewFile = ActiveWorkbook.Name
Windows(NewFile).Activate
Sheets("WIP").Select
ActiveCell.Offset(1, 0).Select
Selection.Activate

Next i
Windows(NewFile).Activate
Sheets("WIP").Select
ActiveCell.Select
Selection.Activate
Call SendKeys("^(S)")

For intCount = 1 To 3 Step -1
lblTimer.Caption = CStr(intCount)
Application.Wait Now + TimeValue("00:01:00")
Next intCount
lblTimer.Caption = "0"

GoTo 300

Exit_Login:
305
Exit Sub
End Sub

2 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
How about renaming the file once it gets downloaded (presuming you know location where it saved and with what name) or may be sendkey might work too.
As I download 100+ I cannot I dont want to rename them one by one after downloading. I have a other macro to do it after downloading. But I want to download them the desired file name.