HTML Code:
Public strAccessDatabaseName As String ' = "C:\Users\tsubasa\Downloads\RahBreth.accdb" 'Path of the database
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdFetch_Click()
Dim strSql As String
Dim lng As Long
Dim strALMSource As String
Dim strALMID As String
For lng = 1 To lstALMSource.ListCount - 1
If lstALMSource.Selected(lng) Then
strALMSource = strALMSource & "'" & lstALMSource.List(lng) & "',"
End If
Next lng
If strALMSource <> "" Then
strALMSource = Left(strALMSource, Len(strALMSource) - 1)
End If
strSql = "SELECT [DAILY ALARM].* FROM [DAILY ALARM] WHERE"
strSql = strSql & vbNewLine
If Len(strALMSource) Then
strSql = strSql & vbNewLine & "([DAILY ALARM].ALMSOURCE) In (" & strALMSource & ")"
strSql = strSql & vbNewLine & ""
strSql = strSql & vbNewLine & "AND"
End If
If cboALMID.Text <> "" Then
strSql = strSql & vbNewLine & ""
strSql = strSql & vbNewLine & "(([DAILY ALARM].ALMID)=" & cboALMID.Text & ")"
strSql = strSql & vbNewLine & ""
strSql = strSql & vbNewLine & "AND"
End If
strSql = strSql & vbNewLine & ""
strSql = strSql & vbNewLine & "(([DAILY ALARM].ALMTM)>=#" & Me.Controls("txtDateFrom").Value & " " & FormatDateTime(Me.Controls("txtTimeFrom").Value, vbLongTime) & "#) AND (([DAILY ALARM].ALMTM)<=#" & Me.Controls("txtDateTo").Value & " " & FormatDateTime(Me.Controls("txtTimeTo").Value, vbLongTime) & "#);"
Worksheets("DAILY ALARM").UsedRange.Offset(1).ClearContents
Call SQLJuicer(strSql, strAccessDatabaseName, Worksheets("DAILY ALARM").Cells(2, 1))
End Sub
Private Sub txtDateFrom_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
frmCalendar.strControlName = "txtDateFrom"
frmCalendar.Show
End Sub
Private Sub txtDateFrom_Enter()
frmCalendar.strControlName = "txtDateFrom"
frmCalendar.Show
End Sub
Private Sub txtDateTo_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
frmCalendar.strControlName = "txtDateTo"
frmCalendar.Show
End Sub
Private Sub txtDateTo_Enter()
frmCalendar.strControlName = "txtDateTo"
frmCalendar.Show
End Sub
Private Sub txtTimeFrom_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
frmTime.strControlName = "txtTimeFrom"
frmTime.Show
End Sub
Private Sub txtTimeFrom_Enter()
frmTime.strControlName = "txtTimeFrom"
frmTime.Show
End Sub
Private Sub txtTimeTo_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
frmTime.strControlName = "txtTimeTo"
frmTime.Show
End Sub
Private Sub txtTimeTo_Enter()
frmTime.strControlName = "txtTimeTo"
frmTime.Show
End Sub
Private Sub UserForm_Activate()
Dim strSql As String
Dim strAccessDestinationTableName As String
Dim strExcelFieldNames As String
Dim strExcelRangeName As String
Dim lng As Long
Const blnDropTableAndCreateNewTable As Boolean = False 'Set to true if you need to drop the table
strAccessDatabaseName = Sheet1.txtDBPath.Text
txtDateFrom.Text = FormatDateTime(Date, vbShortDate)
txtDateTo.Text = FormatDateTime(Date, vbShortDate)
' With Me.Controls.Add("MSComCtl2.DTPicker", "dtpFromDate", True)
' .Top = 222
' .Left = 156
' .Height = 18
' .Width = 110.25
' .Format = 1
' End With
'
' With Me.Controls.Add("MSComCtl2.DTPicker", "dtpFromTime", True)
' .Top = 222
' .Left = 270
' .Height = 18
' .Width = 110.25
' .Format = 2
' End With
'
' With Me.Controls.Add("MSComCtl2.DTPicker", "dtpToDate", True)
' .Top = 240
' .Left = 156
' .Height = 18
' .Width = 110.25
' .Format = 1
' End With
'
' With Me.Controls.Add("MSComCtl2.DTPicker", "dtpToTime", True)
' .Top = 240
' .Left = 270
' .Height = 18
' .Width = 110.25
' .Format = 2
' End With
strAccessDestinationTableName = "[DAILY ALARM]"
Me.lstALMSource.List = Application.Transpose(SQLJuicer("SELECT [ALMSOURCE] FROM " & strAccessDestinationTableName & " GROUP BY [ALMSOURCE] ORDER BY [ALMSOURCE]", strAccessDatabaseName))
Me.cboALMID.List = Application.Transpose(SQLJuicer("SELECT [ALMID] FROM " & strAccessDestinationTableName & " GROUP BY [ALMID] ORDER BY [ALMID]", strAccessDatabaseName))
End Sub
Private Sub UserForm_initialize()
Me.Top = ActiveSheet.Cells(1).Top
Me.Left = ActiveSheet.Cells(1).Left
End Sub
Untitled.jpgUntitled1.jpg
Bookmarks