Option Explicit

Public dTime5min As Date
Public dTime5sec As Date

Public bTimeTick As Boolean
Public dTimeTick As Date

Sub Timer5min()
    Dim h As Integer, m As Integer
    Dim isell As Integer
    Dim ibuy As Integer
    Dim bCont As Boolean
    Dim dt As Date
    Dim min As Integer
    Dim lot As Integer
    Dim lot_s As Integer

    ' Break real-time calculation
    On Error Resume Next
    Application.OnTime EarliestTime:=dTime5sec, Procedure:="Timer5sec", Schedule:=False
    shtDDE.Range("F2").Value = 0
    On Error GoTo 0

    ' Set new 5-min event
    dTime5min = Now + TimeValue("00:05:00")
    dTime5min = dTime5min - TimeValue("00:00:" & itoa00(Second(dTime5min)))
    
    min = Minute(dTime5min)
    min = min - Int(min / 5) * 5
    
    dTime5min = dTime5min - TimeValue("00:" & itoa00(min) & ":00")
    
    Application.OnTime dTime5min, "Timer5min"

    ' Update sheet
    shtDDE.Calculate
    
    If IsNumeric(shtDDE.Range("B2").Value) = True And _
       IsNumeric(shtDDE.Range("C2").Value) = True And _
       IsDate(shtDDE.Range("D2").Value) = True And _
       IsDate(shtDDE.Range("E2").Value) = True Then
    
        ' Update DB
        h = Hour(shtDDE.Range("D2").Value)
        m = Minute(shtDDE.Range("D2").Value)
        If (h < 8) Or (h > 22) Or (h = 22 And m > 0) Then
            ' DAX is closed
        Else
            bCont = True
            If bTimeTick = True Then
                If dTimeTick = shtDDE.Range("D2").Value Then
                    bCont = False
                End If
            End If
            
            'If dTimeTick <> shtDDE.Range("D2").Value Then
            If bCont Then
                Application.ScreenUpdating = False
                
                ' main algo
                isell = shtTradingDAX.Range("isell").Value
                ibuy = shtTradingDAX.Range("ibuy").Value
                lot = shtTradingDAX.Range("lot_enter").Value
                lot_s = shtTradingDAX.Range("lot_enter_s").Value
                
                Call DBDaxUpdate2
                
                ' play sound buy/sell
                If isell = 1 And CInt(shtTradingDAX.Range("isell").Value) = 0 Then
                    
                    ' play sound "BUY"
                    
                    'If lot_s > 0 Then
                    PlayWavFile "buy.wav", False
                    'End If
                    
                    If lot_s > 0 Then
                        ' send signal to the web server
                        ' undo...
                        
                      '  Call WebServer_SendSignal( _
                      '      shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _
                      '      "AX", "buy", shtDDE.Range("B2").Value)
                    End If
                End If
                
                If isell = 0 And CInt(shtTradingDAX.Range("isell").Value) = 1 Then
                    
                    ' play sound "SELL"
                    
                    'If shtTradingDAX.Range("lot_enter_s").Value > 0 Then
                    PlayWavFile "sell.wav", False
                    'End If
                
                    If shtTradingDAX.Range("lot_enter_s").Value > 0 Then
                        ' send signal to the web server
                        ' undo...
                        
                     '   Call WebServer_SendSignal( _
                     '       shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _
                     '       "AX", "sell", shtDDE.Range("B2").Value)
                    End If
                End If
                    
                If ibuy = 1 And CInt(shtTradingDAX.Range("ibuy").Value) = 0 Then
                    
                    ' play sound "SELL"
                    
                    'If lot > 0 Then
                    PlayWavFile "sell.wav", False
                    'End If
                    
                    If lot > 0 Then
                        ' send signal to the web server
                        ' undo...
                        
                     '   Call WebServer_SendSignal( _
                     '       shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _
                     '       "AX", "sell", shtDDE.Range("B2").Value)
                    End If
                End If
                    
                If ibuy = 0 And CInt(shtTradingDAX.Range("ibuy").Value) = 1 Then
                    
                    ' play sound "BUY"
                    
                    'If shtTradingDAX.Range("lot_enter").Value > 0 Then
                    PlayWavFile "buy.wav", False
                    'End If
                
                    If shtTradingDAX.Range("lot_enter").Value > 0 Then
                        ' send signal to the web server
                        ' undo...
                        
                    '    Call WebServer_SendSignal( _
                    '        shtDDE.Range("E2").Value, shtDDE.Range("D2").Value, _
                    '        "AX", "buy", shtDDE.Range("B2").Value)
                    End If
                End If
                    
                ' real-time
                If shtDDE.Range("F2").Value <> 0 Then
                    ' Start real-time calculation
                    dTime5sec = Now + TimeValue("00:00:05")
                    Application.OnTime dTime5sec, "Timer5sec"
                End If
                
                Application.ScreenUpdating = True
            End If
        End If
    End If
    
    ' save a new tick date
    Call SaveLastTickDate
End Sub

Sub Timer5sec()
    dTime5sec = Now + TimeValue("00:00:05")
    Application.OnTime dTime5sec, "Timer5sec"

    ' Update sheet
    shtDDE.Calculate

    ' Real-time calculation
    Application.ScreenUpdating = False
    
    If shtDDE.Range("F2").Value = 1 Then
        '--------------------------------------
        '--------------------------------------
        shtDDE.Range("F2").Value = 0
        '--------------------------------------
        '--------------------------------------
        'Call RealTimeCheck(shtDAX, "B2", shtTradingDAX)
    End If
    
    If shtDDE.Range("F2").Value = 0 Then
        
        ' Break real-time calculation
        On Error Resume Next
        Application.OnTime EarliestTime:=dTime5sec, Procedure:="Timer5sec", Schedule:=False
        On Error GoTo 0
    
    End If
    
    Application.ScreenUpdating = True
End Sub

Sub MyTimerOff()
    On Error Resume Next
    Application.OnTime EarliestTime:=dTime5min, Procedure:="Timer5min", Schedule:=False
    Application.OnTime EarliestTime:=dTime5sec, Procedure:="Timer5sec", Schedule:=False
    On Error GoTo 0
End Sub

Public Sub btnStopTimer()
    Call MyTimerOff
    MsgBox "5min timer is stoped now. Use ""Recovery"" button to restart it"
End Sub

Public Sub btnStartTimer(Optional bShowMsg As Boolean = True)
    ' kill timers
    Call MyTimerOff
    
    ' start a new 5min timer
    Dim min As Integer
    min = Minute(Now)
    min = min - 5 * Int(min / 5)
    dTime5min = Now + TimeValue("00:0" & Trim(CStr(5 - min)) & ":00")
    
    Dim sec As Integer
    sec = Second(dTime5min)
    
    dTime5min = dTime5min - TimeValue("00:00:" & itoa00(sec))
    
    Application.OnTime dTime5min, "Timer5min"
    
    ' get last DDE time value
    Call SaveLastTickDate
    
    If bShowMsg = True Then
        MsgBox "5min timer has been started"
    End If
End Sub

Sub SaveLastTickDate()
    If IsDate(shtDDE.Range("D2").Value) = False Then
        bTimeTick = False
    Else
        bTimeTick = True
        dTimeTick = shtDDE.Range("D2").Value
    End If
End Sub

Sub btnCloseMonth()
    Call DBEndOfMonth("B2", shtTradingDAX)
    MsgBox "Done"
End Sub

Sub DBDaxUpdate2()
    Call UpdateDB(shtDAX, "B2", shtTradingDAX)
    
    Dim sFile As String
    sFile = ThisWorkbook.Path & "\DAX-" & Trim(CStr(Year(shtDDE.Range("B2").Cells(1, 4).Value))) & "-"
    If Month(shtDDE.Range("B2").Cells(1, 4).Value) < 10 Then
        sFile = sFile & "0"
    End If
    sFile = sFile & Trim(CStr(Month(shtDDE.Range("B2").Cells(1, 4).Value))) & ".txt"
    
    'sFile = ...\DAX-YYYY-MM.txt
    'Call WriteToFile(sFile, shtDAX, "B2")

    'sFile = ...\DAX.txt
    sFile = ThisWorkbook.Path & "\DAX.txt"
    'Call WriteToFile(sFile, shtDAX, "B2")
End Sub

Function FileExists(ByVal FileSpec As String) As Boolean
    Dim Attr As Long
    On Error Resume Next
    Attr = GetAttr(FileSpec)
    If Err.Number = 0 Then
        FileExists = Not ((Attr And vbDirectory) = vbDirectory)
    End If
End Function

Sub WriteToFile(sFileName As String, sht As Worksheet, sRange As String)
    Dim iFile As Integer
    
    Dim fLast As Double
    Dim iVolume As Long
    Dim sTime As String
    Dim sDate As String
    
    Dim signalBB As Integer
    Dim signalBS As Integer
    Dim signalSS As Integer
    Dim signalSB As Integer
    
    Dim equity_perday As Variant
    Dim equitys_perday As Variant
    
    ' open text file to writenew signal
    iFile = FreeFile
    If FileExists(sFileName) Then
        ' append to file
        Open sFileName For Append Shared As iFile
    Else
        ' make new file
        Open sFileName For Output As iFile
    End If

    fLast = shtDDE.Range(sRange).Cells(1, 1).Value
    iVolume = shtDDE.Range(sRange).Cells(1, 2).Value
    
    sTime = WorksheetFunction.Text(shtDDE.Range(sRange).Cells(1, 3).Value, "hh:mm:ss")
    sDate = WorksheetFunction.Text(shtDDE.Range(sRange).Cells(1, 4).Value, "dd.mm.yyyy")
    
    signalBB = 0
    If sht.Range("A1").End(xlDown).Cells(1, 29).Value Then signalBB = 1
    
    signalBS = 0
    If sht.Range("A1").End(xlDown).Cells(1, 30).Value Then signalBS = 1
    
    signalSS = 0
    If sht.Range("A1").End(xlDown).Cells(1, 31).Value Then signalSS = 1
    
    signalSB = 0
    If sht.Range("A1").End(xlDown).Cells(1, 32).Value Then signalSB = 1
    
    equity_perday = shtTradingDAX.Range("equity_perday").Value
    equitys_perday = shtTradingDAX.Range("equitys_perday").Value
    
    Write #iFile, fLast, iVolume, sTime, sDate, signalBB, signalBS, signalSS, signalSB, equity_perday, equitys_perday
    Close #iFile
End Sub

automated trading - code vba 1

Visual Basic