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
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
HttpExists = (oXHTTP.Status = 200)
End Function

Open in new window

See attached file.

Naresh PatelTraderAsked:
Who is Participating?
If we understand your question properly, you need to change the following statement

WkBk.SaveAs Filename:=ThisWorkbook.Path & "\" & txtFileName & ".csv", FileFormat:=xlCSV, CreateBackup:=False

Open in new window

to something like this:

WkBk.SaveAs Filename:="D:\AmiBroker Data\NSE\Del\" & txtFileName & ".csv", FileFormat:=xlCSV, CreateBackup:=False

Open in new window

Naresh PatelTraderAuthor Commented:
Naresh PatelTraderAuthor Commented:
Thanks may I ask follow up question i.e. new question?
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Naresh PatelTraderAuthor Commented:
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".
Naresh PatelTraderAuthor Commented:
I mean only new question.Only posting new question link over here.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.