This is a system we use that pulls information from a data system. The compile error I get is "Method or data member not found." This started happening after a system update. I don't know much about the system or Visual Basic but it seems like it's not happy with the syntax in the UserForm_Initialize sub. It highlights the Me.DTPStartTime lines.
Private mCN As ADODB.Connection
Private mExcel As Excel.Application
Private mWBs As Excel.Workbooks
Private mWB As Excel.Workbook
Private Sub cmdGetData_Click()
Dim startdate As String
Dim enddate As String
Dim retval As Long
startdate = Format(Me.DTPStartTime.Value, "mm/dd/yyyy") & " 00:00:00"
enddate = Format(Me.DTPEndTime.Value, "mm/dd/yyyy") & " 00:00:00"
retval = ExportDataToExcel(startdate, enddate)
End Sub
Private Sub cmdRefresh_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub cmdRefresh_Click()
Dim startdate As String
Dim enddate As String
Dim retval As Long
startdate = Format(Me.DTPStartTime.Value, "mm/dd/yyyy") & " 00:00:00"
enddate = Format(Me.DTPEndTime.Value, "mm/dd/yyyy") & " 00:00:00"
retval = GetUniqueData("Part_Number", Me.cboParts, startdate, enddate)
retval = GetUniqueData("Line_Number", Me.cboLines, startdate, enddate)
retval = GetUniqueData("Reject_Code_Number", Me.cboRejects, startdate, enddate)
End Sub
Private Sub cmdTest1_Click()
Dim retval As Long
retval = CreateNewExcelWorkbook(Me.txtFileName.Text)
End Sub
Private Sub DTPEndTime_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub DTPEndTime_CloseUp()
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim answer As Integer
answer = MsgBox("Do you want to shutdown excel?", vbYesNo)
If answer = vbYes Then
Application.Quit
End If
End Sub
Private Sub UserForm_Initialize()
Set mCN = New ADODB.Connection
' mCN.Open "Provider=SQLOLEDB.1;Password=Password08;Persist Security Info=True;User ID=sa;Initial Catalog=Pokeyoke;Data Source=abourque-lt2\sql2008_full"
mCN.Open "Provider=SQLOLEDB.1;Password=Pokeyoke;Persist Security Info=True;User ID=Pokeyoke;Initial Catalog=Pokeyoke;Data Source=10.150.188.75"
Me.DTPStartTime = DateAdd("d", -1, Now)
Me.DTPEndTime = Now
'Me.DTPStartTime = "09/02/2014"
'Me.DTPEndTime = "09/04/2014"
End Sub
Private Function GetUniqueData(fieldname As String, cbo As ComboBox, startdate As String, enddate As String) As Long
Dim rs As New ADODB.Recordset
Dim strsql As String
Dim wb As Excel.Workbook
On Error GoTo errorhandler
cbo.Clear
cbo.AddItem "All"
If startdate < enddate Then
'build sql to get unique parts
strsql = "Select distinct " & fieldname & " from ProductDataView where timestamp between '" & startdate & "' and '" & enddate & "' order by " & fieldname
rs.Open strsql, mCN, 3, 1
Do While Not rs.EOF
cbo.AddItem rs.Fields(0)
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End If
cbo.ListIndex = 0
Exit Function
errorhandler:
GetUniqueParts = Err.Number
End Function
Private Function ExportDataToExcel(startdate As String, enddate As String) As Long
Dim rs As New ADODB.Recordset
Dim strsql As String
Dim whereClause As String
Dim retval As Long
On Error GoTo errorhandler
strsql = "Select * from ProductDataView where timestamp between '" & startdate & "' and '" & enddate & "'"
whereClause = ""
'now determine the whereclause
If Me.cboLines.Text <> "" And UCase(Me.cboLines.Text) <> "ALL" Then
whereClause = whereClause & " and Line_Number = " & Me.cboLines.Text
End If
'now determine the whereclause
If Me.cboParts.Text <> "" And UCase(Me.cboParts.Text) <> "ALL" Then
whereClause = whereClause & " and Part_Number = " & Me.cboParts.Text
End If
'now determine the whereclause
If Me.cboRejects.Text <> "" And UCase(Me.cboRejects.Text) <> "ALL" Then
whereClause = whereClause & " and Reject_Code_Number = " & Me.cboRejects.Text
End If
strsql = strsql & whereClause & " order by timestamp"
Debug.Print strsql
'rs.Open strSQL, mCN
retval = CreateNewExcelWorkbook(Me.txtFileName.Text)
retval = FillExcelWithData(mWB, strsql, mCN.ConnectionString)
Exit Function
errorhandler:
ExportDataToExcel = Err.Number
End Function
Private Function FillExcelWithData(wb As Workbook, strsql As String, connectstring As String) As Long
Dim Sheet As Worksheet
Dim i As Integer
mExcel.WindowState = xlMaximized
mWB.Activate
mWB.Sheets("Sheet1").Activate
Set Sheet = mWB.Sheets("Sheet1")
Sheet.Cells.ClearContents
Dim rs As New ADODB.Recordset
rs.Open strsql, mCN
For i = 0 To rs.Fields.Count - 1
Set cl = Sheet.Cells(1, i + 1)
cl.Value = rs.Fields(i).Name
Next
If Not rs.EOF Then
Sheet.Range("A2").CopyFromRecordset rs
End If
rs.Close
mWB.Activate
'now format the time column F
Sheet.Range("F2").EntireColumn.NumberFormat = "mm/dd/yyyy hh:mm:ss"
' ActiveCell.EntireColumn.Select
' Selection.NumberFormat = "mm/dd/yyyy hh:mm:ss"
Sheet.Columns.EntireColumn.AutoFit
'.Refresh
' Set mWB = mWBs.OpenDatabase(connectstring, strsql)
End Function
Private Function CreateNewExcelWorkbook(workbookName As String) As Long
On Error GoTo errorhandler
If mExcel Is Nothing Then
Set mExcel = New Excel.Application
End If
mExcel.Visible = True
Set mWB = mExcel.Workbooks.Add()
'oWB.SaveAs workbookName
Set mWBs = mExcel.Workbooks
Exit Function
'oWB.Name = workbookName
errorhandler:
CreateNewExcelWorkbook = Err.Number
End Function
Let me know if you need more information, thank you.
