InfoLab data export daemon: Perbedaan revisi

(Instalasi)
(InfoLab data export daemon: upload data laboratorium Otomatis)
Baris 5: Baris 5:
 
==Instalasi==
 
==Instalasi==
  
'''1. Membuat Tabel'''
+
==='''1. Membuat Tabel'''===
* Nama Tabel : tIMEL
+
  Nama Tabel : tIMEL
{| class="wikitable"
+
  {| class="wikitable"
 
|-
 
|-
 
! Fieldname !! DataType !! input mask !! Description
 
! Fieldname !! DataType !! input mask !! Description
Baris 24: Baris 24:
 
|}
 
|}
  
'''2. Membuat Form'''
+
==='''2. Membuat Form'''===
* Nama Form : fIMEL
+
  Nama Form : fIMEL
* Gambar1
+
#* Gambar1
  
  
'''3. Menuliskan Kode Program'''
+
==='''3. Menuliskan Kode Program'''===
  
 
'''  3.1. Deklarasi Variabel'''
 
'''  3.1. Deklarasi Variabel'''
  
Option Compare Database
+
  Option Compare Database
Option Explicit
+
  Option Explicit
Dim rsz As DAO.Recordset
+
  Dim rsz As DAO.Recordset
Dim SQLz As String  
+
  Dim SQLz As String  
  
 
'''  3.2. Form Event OnLoad'''
 
'''  3.2. Form Event OnLoad'''
  
Private Sub Form_Load()
+
  Private Sub Form_Load()
SQLz = "select * from timel;"
+
  SQLz = "select * from timel;"
Set rsz = CurrentDb.OpenRecordset(SQLz)
+
  Set rsz = CurrentDb.OpenRecordset(SQLz)
End Sub
+
  End Sub
  
 
'''  3.3. Form Event OnTimer'''
 
'''  3.3. Form Event OnTimer'''
  
Private Sub Form_Timer()
+
  Private Sub Form_Timer()
If IsInternetConnected() = True Then
+
  If IsInternetConnected() = True Then
Application.Echo False
+
  Application.Echo False
Me!Label1.Caption = Format(Now(), "HH:NN:SS")
+
  Me!Label1.Caption = Format(Now(), "HH:NN:SS")
Application.Echo True
+
  Application.Echo True
If UCase(Me!Label1.Caption) = rsz!JamKirim1 Then Call Command_Send_Click
+
  If UCase(Me!Label1.Caption) = rsz!JamKirim1 Then Call Command_Send_Click
If UCase(Me!Label1.Caption) = rsz!JamKirim2 Then Call Command_Send_Click
+
  If UCase(Me!Label1.Caption) = rsz!JamKirim2 Then Call Command_Send_Click
Else
+
  Else
Application.Echo False
+
    Application.Echo False
Me!Label1.Caption = Format(Now(), _
+
    Me!Label1.Caption = Format(Now(), _
"HH:NN:SS") & " No/Limited Connection"
+
  "HH:NN:SS") & " No/Limited Connection"
Application.Echo True
+
  Application.Echo True
End If
+
  End If
End Sub
+
  End Sub
  
 
'''  3.4. Command_Send OnClick'''
 
'''  3.4. Command_Send OnClick'''
  
Private Sub Command_Send_Click()
+
  Private Sub Command_Send_Click()
DoCmd.TransferSpreadsheet acExport, acSpreadsheet_
+
  DoCmd.TransferSpreadsheet acExport, acSpreadsheet_
TypeExcel12Xml , "infolab", "C:/infolab/dataexcell.xlsx", True, "", False
+
  TypeExcel12Xml , "infolab", "C:/infolab/dataexcell.xlsx", True, "", False
If IsInternetConnected() = True Then
+
  If IsInternetConnected() = True Then
Call SendMail
+
  Call SendMail
End If
+
  End If
End Sub
+
  End Sub
  
 
==Menyisipkan Modul==
 
==Menyisipkan Modul==
 
#Nama Modul mImel
 
#Nama Modul mImel
Option Compare Database
+
  Option Compare Database
Private Declare Function InternetGetConnectedState _
+
  Private Declare Function InternetGetConnectedState _
 
   Lib "wininet.dll" (ByRef dwflags As Long, _
 
   Lib "wininet.dll" (ByRef dwflags As Long, _
 
   ByVal dwReserved As Long) As Long
 
   ByVal dwReserved As Long) As Long
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
+
  Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
+
  Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
+
  Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
+
  Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Option Explicit
+
  Option Explicit
Function IsInternetConnected() As Boolean
+
  Function IsInternetConnected() As Boolean
 
     Dim L As Long
 
     Dim L As Long
 
     Dim R As Long
 
     Dim R As Long
Baris 96: Baris 96:
 
         End If
 
         End If
 
     End If
 
     End If
End Function
+
  End Function
Public Sub SendMail()
+
  Public Sub SendMail()
Dim iCfg As CDO.Configuration
+
  Dim iCfg As CDO.Configuration
Dim iMsg As CDO.Message
+
  Dim iMsg As CDO.Message
Set iCfg = New CDO.Configuration
+
  Set iCfg = New CDO.Configuration
Set iMsg = New CDO.Message
+
  Set iMsg = New CDO.Message
Dim xrs As DAO.Recordset
+
  Dim xrs As DAO.Recordset
Dim xSQL As String
+
  Dim xSQL As String
xSQL = "select * from timel;"
+
  xSQL = "select * from timel;"
Set xrs = CurrentDb.OpenRecordset(xSQL)
+
  Set xrs = CurrentDb.OpenRecordset(xSQL)
With iCfg.Fields
+
  With iCfg.Fields
 
   .Item(cdoSendUsingMethod) = cdoSendUsingPort
 
   .Item(cdoSendUsingMethod) = cdoSendUsingPort
 
   .Item(cdoSMTPServerPort) = 465
 
   .Item(cdoSMTPServerPort) = 465
Baris 116: Baris 116:
 
   .Item(cdoSendEmailAddress) = "Do Not Reply" & "<" & xrs!EMail & ">"
 
   .Item(cdoSendEmailAddress) = "Do Not Reply" & "<" & xrs!EMail & ">"
 
   .Update
 
   .Update
End With
+
  End With
With iMsg
+
  With iMsg
 
   .Configuration = iCfg
 
   .Configuration = iCfg
 
   .Subject = "Subject"
 
   .Subject = "Subject"
Baris 124: Baris 124:
 
   .AddAttachment xrs!Lampiran
 
   .AddAttachment xrs!Lampiran
 
   .Send
 
   .Send
End With
+
  End With
Set iMsg = Nothing
+
  Set iMsg = Nothing
Set iCfg = Nothing
+
  Set iCfg = Nothing
End Sub
+
  End Sub
Private Sub Form_Timer()
+
  Private Sub Form_Timer()
If IsInternetConnected() = True Then
+
  If IsInternetConnected() = True Then
Application.Echo False
+
  Application.Echo False
Me!Label1.Caption = Format(Now(), "HH:NN:SS")
+
  Me!Label1.Caption = Format(Now(), "HH:NN:SS")
Application.Echo True
+
  Application.Echo True
If UCase(Me!Label1.Caption) = rsz!JamKirim1 Then  
+
  If UCase(Me!Label1.Caption) = rsz!JamKirim1 Then  
Call Command_Send_Click
+
  Call Command_Send_Click
If UCase(Me!Label1.Caption) = rsz!JamKirim2 Then  
+
  If UCase(Me!Label1.Caption) = rsz!JamKirim2 Then  
Call Command_Send_Click
+
  Call Command_Send_Click
Else
+
  Else
Application.Echo False
+
  Application.Echo False
Me!Label1.Caption = Format(Now(), "HH:NN:SS") & " No/Limited Connection"
+
  Me!Label1.Caption = Format(Now(), "HH:NN:SS") & " No/Limited Connection"
Application.Echo True
+
  Application.Echo True
End If
+
  End If
End Sub
+
  End Sub

Revisi per 19 Agustus 2015 09.59

InfoLab data export daemon: upload data laboratorium Otomatis

Pengenalan

iSIKHNAS modul upload data laboratorium bertujuan untuk mengintegrasikan data hasil pengujian laboratorium (tipe A) secara otomatis melalui E-Mail. Modul ini merupakan salah satu fitur yang dimiliki iSIKHNAS yang di sisipkan kedalam infolab yang berbasis Ms. Access, memanfaatkan Server SMTP Gmail. Server SMTP Gmail berfungsi me-relai pesan dari perangkat atau aplikasi(infolab). Dengan menghubungkannya ke smtp.gmail.com pada port 465, maka anda dapat mengirim email ke siapa saja. Untuk tersambung menggunakan SSL, Anda harus memberikan nama pengguna dan sandi Google untuk autentikasi.

Instalasi

1. Membuat Tabel

  Nama Tabel : tIMEL
Fieldname DataType input mask Description
Email Text(100) Akun Gmail
Katasandi Text(100) Password Password Akun Gmail
Kepada Text(100) Akun Penerima Email
Jamkirim1 Datetime Jam Pengiriman Email 1
Jamkirim2 Datetime Jam Pengiriman Email 2
Lampiran Text(255) File Lampiran

2. Membuat Form

  Nama Form : fIMEL
    • Gambar1


3. Menuliskan Kode Program

3.1. Deklarasi Variabel

 Option Compare Database
 Option Explicit
 Dim rsz As DAO.Recordset
 Dim SQLz As String 

3.2. Form Event OnLoad

  Private Sub Form_Load()
  SQLz = "select * from timel;"
  Set rsz = CurrentDb.OpenRecordset(SQLz)
  End Sub

3.3. Form Event OnTimer

 Private Sub Form_Timer()
 If IsInternetConnected() = True Then
  Application.Echo False
  Me!Label1.Caption = Format(Now(), "HH:NN:SS")
  Application.Echo True
 If UCase(Me!Label1.Caption) = rsz!JamKirim1 Then Call Command_Send_Click
 If UCase(Me!Label1.Caption) = rsz!JamKirim2 Then Call Command_Send_Click
 Else
   Application.Echo False
   Me!Label1.Caption = Format(Now(), _
  "HH:NN:SS") & " No/Limited Connection"
  Application.Echo True
 End If
 End Sub

3.4. Command_Send OnClick

  Private Sub Command_Send_Click()
  DoCmd.TransferSpreadsheet acExport, acSpreadsheet_
  TypeExcel12Xml , "infolab", "C:/infolab/dataexcell.xlsx", True, "", False
  If IsInternetConnected() = True Then
  Call SendMail
  End If
 End Sub

Menyisipkan Modul

  1. Nama Modul mImel
  Option Compare Database
  Private Declare Function InternetGetConnectedState _
  Lib "wininet.dll" (ByRef dwflags As Long, _
  ByVal dwReserved As Long) As Long
  Private Const INTERNET_CONNECTION_MODEM As Long = &H1
  Private Const INTERNET_CONNECTION_LAN As Long = &H2
  Private Const INTERNET_CONNECTION_PROXY As Long = &H4
  Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
  Option Explicit
  Function IsInternetConnected() As Boolean
   Dim L As Long
   Dim R As Long
   R = InternetGetConnectedState(L, 0&)
   If R = 0 Then
       IsInternetConnected = False
   Else
       If R <= 4 Then
           IsInternetConnected = True
       Else
           IsInternetConnected = False
       End If
   End If
  End Function
  Public Sub SendMail()
  Dim iCfg As CDO.Configuration
  Dim iMsg As CDO.Message
  Set iCfg = New CDO.Configuration
  Set iMsg = New CDO.Message
  Dim xrs As DAO.Recordset
  Dim xSQL As String
  xSQL = "select * from timel;"
  Set xrs = CurrentDb.OpenRecordset(xSQL)
  With iCfg.Fields
  .Item(cdoSendUsingMethod) = cdoSendUsingPort
  .Item(cdoSMTPServerPort) = 465
  .Item(cdoSMTPServer) = "smtp.gmail.com"
  .Item(cdoSMTPUseSSL) = True
  .Item(cdoSMTPAuthenticate) = 1
  .Item(cdoSendUserName) = xrs!EMail
  .Item(cdoSendPassword) = xrs!KataSandi
  .Item(cdoSendEmailAddress) = "Do Not Reply" & "<" & xrs!EMail & ">"
  .Update
 End With
 With iMsg
  .Configuration = iCfg
  .Subject = "Subject"
  .To = xrs!Kepada
  .TextBody = ""
  .AddAttachment xrs!Lampiran
  .Send
 End With
 Set iMsg = Nothing
 Set iCfg = Nothing
 End Sub
 Private Sub Form_Timer()
 If IsInternetConnected() = True Then
 Application.Echo False
 Me!Label1.Caption = Format(Now(), "HH:NN:SS")
 Application.Echo True
 If UCase(Me!Label1.Caption) = rsz!JamKirim1 Then 
 Call Command_Send_Click
 If UCase(Me!Label1.Caption) = rsz!JamKirim2 Then 
 Call Command_Send_Click
 Else
 Application.Echo False
  Me!Label1.Caption = Format(Now(), "HH:NN:SS") & " No/Limited Connection"
  Application.Echo True
 End If
 End Sub