Naresh Patel
asked on
VBA Save Location
Hi Experts,
I have one WB which download files from web. files which downloaded is saved to active WB location I need to change this location to "D:\AmiBroker Data\NSE\Del" & which is fixed hard coded in Code it self.
here the code
See attached file.
Thanks
I have one WB which download files from web. files which downloaded is saved to active WB location I need to change this location to "D:\AmiBroker Data\NSE\Del" & which is fixed hard coded in Code it self.
here the code
Private Function LastRow(TheWorksheet As Worksheet) As Long
If WorksheetFunction.CountA(TheWorksheet.Cells) > 0 Then
LastRow = TheWorksheet.Cells.Find(What:="*", After:=TheWorksheet.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End Function
Sub Macro1()
Application.ScreenUpdating = False
startDate = Range("C2").Value
stopDate = Range("C3").Value
For xx = startDate To stopDate
If HttpExists("http://nseindia.com/archives/equities/mto/MTO_" & Format(xx, "ddmmyyyy") & ".DAT") Then
Dim WkBk As Excel.Workbook
Dim txtFileName As String
txtFileName = Format(xx, "ddmmyyyy")
Set WkBk = Workbooks.Add
With ActiveSheet.QueryTables.Add(Connection:="URL;http://nseindia.com/archives/equities/mto/MTO_" & Format(xx, "ddmmyyyy") & ".DAT", Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False
ActiveSheet.Range("H5:H" & LastRow(ActiveSheet)).Value = Format(xx, "dd-mmm-yyyy")
Application.DisplayAlerts = False
WkBk.SaveAs Filename:=ThisWorkbook.Path & "\" & txtFileName & ".csv", FileFormat:=xlCSV, CreateBackup:=False
WkBk.Close (False)
Application.DisplayAlerts = True
End If
Next xx
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Function HttpExists(sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = (oXHTTP.Status = 200)
End Function
See attached file.
Thanks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks may I ask follow up question i.e. new question?
ASKER
may I?
If it is a new question, it would be better to ask it as a separate question. And as for me, I do not guarantee I can answer it fast.
Don't forget that this question is already marked as "answered".
Don't forget that this question is already marked as "answered".
ASKER
I mean only new question.Only posting new question link over here.
Thanks
Thanks
ASKER
EE-Sample.xlsm