VBA excel - excel creating empty csv files when using application.ontime

Question

I got a macro that runs every 30 seconds using Application.Ontime. Every iteration creates a new csv file containing 8 columns and between 50 to 100 rows. The Application.Ontime normally runs from 8am to 5pm.

The problem is that sometimes during the day the macro just stop storing data in the csv files but still creates csv files. Hence, it still creates csv files but without any data in it.

EDIT:

The files that are created contain headers (StdTenorArray(0))
The variable StdXXXXXX is defined in another macro (button) and is a global variable

Here is the code:

Sub RunOnTime()
Application.CutCopyMode = False
Set ThisWkb = ThisWorkbook

dTime = Now + TimeSerial(0, 0, 30)
Application.OnTime dTime, "RunOnTime"

Call csvFileArray
Set ThisWkb = Nothing
End Sub

The above code calls this macro:

Sub csvFileArray()
Dim StdTenorArray(), ArkArr(5) As Variant
Dim FileName As String
Dim StdTenorCnt, h, j As Long
Set ThisWkb = ThisWorkbook
Application.CutCopyMode = False
ArkArr(1) = "XXXXXXctb"
ArkArr(2) = "XXXXXctb"
ArkArr(3) = "XXXXctb"
ArkArr(4) = "XXXctb"
ArkArr(5) = "XXctb"


ReDim StdTenorArray(ThisWkb.Sheets(ArkArr(1)).Range("B" & Rows.Count).End(xlUp).Row + ThisWkb.Sheets(ArkArr(2)).Range("B" & Rows.Count).End(xlUp).Row + ThisWkb.Sheets(ArkArr(3)).Range("B" & Rows.Count).End(xlUp).Row + ThisWkb.Sheets(ArkArr(4)).Range("B" & Rows.Count).End(xlUp).Row + ThisWkb.Sheets(ArkArr(5)).Range("B" & Rows.Count).End(xlUp).Row)


'Standard tenors
StdTenorCnt = 1
If StdXXXXXX = True Then
    For j = 5 To 29
        If UCase(ThisWkb.Sheets(ArkArr(1)).Cells(j, 4)) = True _
        And WorksheetFunction.IsNumber(ThisWkb.Sheets(ArkArr(1)).Cells(j, 10)) = True _
        And WorksheetFunction.IsNumber(ThisWkb.Sheets(ArkArr(1)).Cells(j, 11)) = True _
        And IsDate(ThisWkb.Sheets(ArkArr(1)).Cells(j, 7)) = True _
        And IsDate(ThisWkb.Sheets(ArkArr(1)).Cells(j, 8)) = True Then

            StdTenorArray(StdTenorCnt) = "" & ThisWkb.Sheets(ArkArr(1)).Cells(j, 5) & ";" & Format(ThisWkb.Sheets(ArkArr(1)).Cells(j, 7), "yyyymmdd") & ";" & Format(ThisWkb.Sheets(ArkArr(1)).Cells(j, 8), "yyyymmdd") & ";" & ThisWkb.Sheets(ArkArr(1)).Cells(j, 9) & ";" & Replace(Format(ThisWkb.Sheets(ArkArr(1)).Cells(j, 10), "##0.00"), ",", ".") & ";" & Replace(Format(ThisWkb.Sheets(ArkArr(1)).Cells(j, 11), "##0.00"), ",", ".") & ";" & ThisWkb.Sheets(ArkArr(1)).Cells(j, 6) & ";JPD"
            StdTenorCnt = StdTenorCnt + 1
        End If
    Next j
End I.

.
.
'more storing in the array like the part above
.
.

StdTenorArray(0) = "Symbol;SpotDate;ValueDate;Removed;Bid;Offer;Tenor;Channel"

Set fs = CreateObject("Scripting.FileSystemObject")

'test
app_path = ThisWkb.Path
Set a = fs.CreateTextFile("" & app_path & "\Test\" & Strings.Format(Now(), "dd.mm.yyyy") & " " & Strings.Format(Now(), "hh.mm.ss") & "." & Strings.Right(Strings.Format(Timer(), "#0.00"), 2) & ".csv", True)



For j = 0 To StdTenorCnt - 1
    a.WriteLine ("" & StdTenorArray(j) & "")
Next j

a.Close
ThisWkb.Sheets("DKK").Cells(1, 27) = "" & Strings.Format(Now(), "hh:mm:ss") & ":" & Strings.Right(Strings.Format(Timer(), "#0.00"), 2) & ""
ReDim StdTenorArray(0)
Set fs = Nothing
Set a = Nothing
Set ThisWkb = Nothing
Application.CutCopyMode = False
End Sub

Hope someone have a solution to this problem or maybe can point me in the right direction.

Have a nice weekend.

\Kristian

VBA excel - excel creating empty csv files when using application.ontime

0 Answers