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 | |
− | {| 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 | |
− | * 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" | |
− | + | Application.Echo True | |
− | End If | + | End If |
− | End Sub | + | End Sub |
Revisi per 19 Agustus 2015 09.59
Daftar isi
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 |
---|---|---|---|
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
- 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