InfoLab data export daemon

Revisi per 19 Agustus 2015 09.46 oleh Priyono (bicara | kontrib) (Instalasi)

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