troubleshooting Question

VBA Save Location

Avatar of Naresh Patel
Naresh PatelFlag for India asked on
Microsoft OfficeMicrosoft ExcelOffice Suites-Other
6 Comments1 Solution401 ViewsLast Modified:
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("" & 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;" & 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

See attached file.


Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 6 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 6 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros