+ Reply to Thread
Results 1 to 2 of 2

code fails on ".refresh" sometimes.

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    04-02-2017
    Location
    Australia
    MS-Off Ver
    2016
    Posts
    405

    code fails on ".refresh" sometimes.

    Hi guys,

    The following code works but sometimes fails on the ".Refresh" step, I am wondering if there is any way I can fix this and prevent it from failing. Any ideas?

    Sub Grader()
    
    Call ImportCSVFile
    Call YesterdayTo_Today
    Call CopyToCsv
    
    End Sub
    
    
    
    Sub ImportCSVFile()
    
        Dim Ws As Worksheet
        Dim FileName As String
    
        Set Ws = ActiveWorkbook.Sheets("Sheet1")    ' change to suit
    
    'Sheets("Sheet1").ClearContents
    'Sheets("Sheet1").Clear
    'Sheets("Sheet1").Cells.QueryTable.Delete
    'Sheets("Sheet1").Cells.ClearContents
    
        With Sheets("Sheet1")
          .Range("A1", Sheets("Sheet1").Range("A2").SpecialCells(xlLastCell)).Clear
        End With
    
    FileName = "\\rapidproto_datashare\rapidproto_datashare\data\B4\shift_speeds\B4_grader_speeds_7days.csv"
    '    FileName = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select source file")
    
        With Ws.QueryTables.Add(Connection:="TEXT;" & FileName, _
                                Destination:=Ws.Range("A1"))       ' change to suit
             .TextFileParseType = xlDelimited
             .TextFileCommaDelimiter = True
             .Refresh
        End With
    End Sub
    
    Sub YesterdayTo_Today()
    
    Dim dDate As Date
    Dim strDate As String
    Dim lDate As Double
    dDate = Date - 1 + 0.25
    lDate = dDate
    'Range("A2", ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=5, Criteria1:=">=" & Date - 1 + 0.25, Operator:=xlAnd
    Range(Sheets("Sheet1").Range("A2"), Sheets("Sheet1").Range("A2").SpecialCells(xlLastCell)).AutoFilter Field:=5, Criteria1:=">=" & lDate, Operator:=xlAnd
    
    End Sub
    
    'Option Explicit
    
    Sub CopyToCsv()
    
    'sPath = Environ("USERPROFILE")
    Set objNetwork = CreateObject("Wscript.Network")
    CurrentUser = objNetwork.UserName
    
    
    '    Const TARGET_FOLDER = "C:\Temp\" 'Folder you save your CSV files in
    '    Const TARGET_FOLDER = Environ$("USERPROFILE") & "\Desktop\" 'Folder you save your CSV files in
    TARGET_FOLDER = "C:\Users\" & CurrentUser & "\Desktop\" 'Folder you save your CSV files in
        Const MYFILENAME = "GradeData"
    
        Dim DataSheet As Worksheet
        Dim CsvWorkbook As Workbook
        Dim CsvSheet As Worksheet
        
        Set DataSheet = ActiveSheet 'Replace with relevant sheet
        DataSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy
        Set CsvWorkbook = Workbooks.Add
        CsvWorkbook.Sheets(1).Paste
        Application.DisplayAlerts = False
        CsvWorkbook.SaveAs FileName:=TARGET_FOLDER & MYFILENAME & ".csv", FileFormat:=xlCSV, local:=True
        CsvWorkbook.Close
        Application.DisplayAlerts = True
    End Sub
    
    Sub show()
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
      ActiveSheet.ShowAllData
    End If
    End Sub
    Thanks,

    JimmyWilliams

  2. #2
    Forum Expert ByteMarks's Avatar
    Join Date
    07-23-2018
    Location
    UK
    MS-Off Ver
    O365 32bit (Windows)
    Posts
    3,086

    Re: code fails on ".refresh" sometimes.

    You could try

    Sub ImportCSVFile()
    
        Dim Ws As Worksheet
        Dim FileName As String
    
        Set Ws = ActiveWorkbook.Sheets("Sheet1")    ' change to suit
    
    'Sheets("Sheet1").ClearContents
    'Sheets("Sheet1").Clear
    'Sheets("Sheet1").Cells.QueryTable.Delete
    'Sheets("Sheet1").Cells.ClearContents
    
        With Sheets("Sheet1")
          .Range("A1", Sheets("Sheet1").Range("A2").SpecialCells(xlLastCell)).Clear
        End With
    
    FileName = "\\rapidproto_datashare\rapidproto_datashare\data\B4\shift_speeds\B4_grader_speeds_7days.csv"
    '    FileName = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select source file")
    
        With Ws.QueryTables.add(Connection:="TEXT;" & FileName, _
                                Destination:=Ws.Range("A1"))       ' change to suit
             .TextFileParseType = xlDelimited
             .TextFileCommaDelimiter = True
             
             .TextFileColumnDataTypes = 2 'treat as text
             
             .Refresh BackgroundQuery:=False
        End With
        Ws.QueryTables(1).Delete 'delete the query leaving the data
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] "ActiveWorkbook.Path" fails - triggers "Compile Error Object required"
    By Ochimus in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 12-15-2018, 02:58 PM
  2. [SOLVED] If Dir(PathName & "\" & FileData) = "" Then - fails
    By dflak in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 06-20-2017, 04:27 PM
  3. Replies: 4
    Last Post: 06-01-2017, 11:45 PM
  4. [SOLVED] Why does the "CountIF" function fails on value "Monday Week 1"?
    By kashbg in forum Excel Formulas & Functions
    Replies: 7
    Last Post: 06-02-2015, 03:24 PM
  5. Running Code After "Opening File" Event Has Triggered Data Connection Refresh
    By david.nicholls in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 07-09-2013, 07:22 AM
  6. If "String Variable" = "" then: (Fails)
    By vin1 in forum Excel Programming / VBA / Macros
    Replies: 11
    Last Post: 02-17-2012, 07:11 AM
  7. Replies: 6
    Last Post: 12-21-2005, 07:20 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1