VBA ConnectionTimeout problems

From: Matt. (matt_benvenuti_remove_at_hotmail.com)
Date: 11/11/04 

Date: Thu, 11 Nov 2004 11:34:14 -0500

Hi all!

I'm experiencing a very frustrating Timeout problem. The SQL Server is very
busy, getting data delivered to it from 20 die cast machine PLCs using
RSLinx. But it has over 2 GB of RAM, so it should be able to handle this.
As you'll note, I've tried editing the ConnectionTimeout property, but cell
J1 always reports 30 or 31 seconds as th elapsed time.

Server is MS SQL Server 2000
Compaq Proliant ML 320

Client is Excel 2000.

Network is standard TCP/IP over ethernet.

Any ideas greatly appreciated.

cheers,
Matt.

Sub Main()
''''''''''''''''''''''''''''''''''''''''
' Author: Matt Benvenuti
' Date delivered: 2004/09/02
' Primary user: Razia Dinath for recording Production information
'
''''''''''''''''''''''''''''''''''''''''
' This function is called from a button on DCMData work***.
'
' The purpose of this function is to return data from the MS SQL Server
related to
' DCM shot counts and run time, as measured by the tools in place to
perform these tasks. The
' function works as follows:
'
' 1) open a connection to the SQL Server and populate a recordset for
' a production date the user specifies;
' 2) copy that data to a work*** called DCMData
' 3) close the workbook, and end execution
'''''''''''''''''''''''''''''''''''''''''
On Error GoTo Err_Sub

    Dim strConnection As String
    Dim strSQL As String
    Dim oWorkBook As Workbook 'workbook connection
    Dim connDB As New ADODB.Connection 'connection to SQL Server
database
    Dim rsDCMDataDays As ADODB.Recordset 'recordset for DCM data
    Dim rsDCMDataNights As ADODB.Recordset 'recordset for DCM data
    Dim rsDCMTimes As ADODB.Recordset

    Dim ExcelDate As String
    Dim ExcelDateNight As Date
    Dim strTimeDay As String
    Dim strTimeAft As String
    Dim strTimeNight As String
    Dim strShiftProductionStart As String
    Dim strShiftProductionEnd As String
    Dim intHeaderCol As Integer

    Dim intDCM As Integer
    Dim intShiftCount As Integer

    Dim intDowntimeInterval As Integer

    Dim strMsg As String 'error message variables
    Dim datStart As Date
    Dim intElapse As Integer
'''''''''''''''''''''''''''''''''''''''''
' set downtime interval to 4 minutes (240 seconds)
'''''''''''''''''''''''''''''''''''''''''
    intDowntimeInterval = 240

'''''''''''''''''''''''''''''''''''''''''
' set shift times
'''''''''''''''''''''''''''''''''''''''''
    strTimeDay = "07:00:00"
    strTimeAft = "15:00:00"
    strTimeNight = "23:00:00"

    ExcelDate = Format(Date - 1, "yyyy-mm-dd")
    ExcelDate = InputBox("Enter the Production date: ", "Production Date
box", ExcelDate)
    If ExcelDate = "" Then ' user pressed Cancel button
        GoTo Exit_Sub
    End If
' ExcelDateNight = DateAdd("d", -1, ExcelDate) 'night shift starts day
before "production date"
    ExcelDateNight = DateAdd("d", 1, ExcelDate) 'night shift starts day
after "production date"

'''''''''''''''''''''''''''''''''''''''''
' open the connection to the SQL Server
'''''''''''''''''''''''''''''''''''''''''
    datStart = Now()
    connDB.ConnectionString = "Provider=sqloledb;Data Source=H2242-PLC;" _
        & "Initial Catalog=*****;User Id=*****;Password=*****"
    connDB.ConnectionTimeout = 120
    connDB.Open

    intShiftCount = 1
    Sheets("DCMData").Range("A1:I30").ClearContents
    Sheets("DCMData").Range("A1:I30").ClearFormats

    While intShiftCount <= 3
        Select Case intShiftCount
            Case 1
                strShiftProductionStart = Format(ExcelDate & " " &
strTimeDay, "yyyy-mm-dd hh:mm:ss")
                strShiftProductionEnd = Format(ExcelDate & " " & strTimeAft,
"yyyy-mm-dd hh:mm:ss")
                intHeaderCol = 1
            Case 2
                strShiftProductionStart = Format(ExcelDate & " " &
strTimeAft, "yyyy-mm-dd hh:mm:ss")
                strShiftProductionEnd = Format(ExcelDate & " " &
strTimeNight, "yyyy-mm-dd hh:mm:ss")
                intHeaderCol = 4
            Case 3
                strShiftProductionStart = Format(ExcelDate & " " &
strTimeNight, "yyyy-mm-dd hh:mm:ss")
                strShiftProductionEnd = Format(ExcelDateNight & " " &
strTimeDay, "yyyy-mm-dd hh:mm:ss")
                intHeaderCol = 7
        End Select

        Call ShiftInfo(strShiftProductionStart, strShiftProductionEnd,
intDowntimeInterval, intHeaderCol, connDB, ExcelDate)
        intShiftCount = intShiftCount + 1
    Wend

Exit_Sub:
    Set connDB = Nothing
    Set oWorkBook = Nothing
    Exit Sub

Err_Sub:
    intElapse = (Now() - datStart) * 24 * 60 * 60
    Cells(1, 10).Value = intElapse
    strMsg = "Error # " & Str(Err.Number) & " was generated by " &
Err.Source & Chr(13) & Err.Description
    MsgBox strMsg, , "Error", Err.HelpFile, Err.HelpContext
' MsgBox Err.Number & Err.Description
    Resume Exit_Sub

End Sub

Quantcast