3 Messages
Digest #3965
Messages
Tue Sep 13, 2016 7:38 pm (PDT) . Posted by:
"Heru Safrudin" heru.safrudin
Dear be Exceller..
Bisakah VBA mendapatkan hasil informasi ping ke dari alamat tertentu
Contoh :
Ping statistics for 123.456.789:
Packets: Sent = 4, Received = 0, Lost = 4 (100% loss)
Mohon pencerahannya
<ymsgr:sendIM?
Tue Sep 13, 2016 11:33 pm (PDT) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Hai Heru,
Bisa.
Untuk apa ya hasil ping nya ?
ya wis lah... untuk apa sajalah...
Asumsi : hasilnya ditulis di kolom A sheet pertama dalam tab sheet di
workbook berisi script
Peringatan :
- perhatikan dan bandingkan bagian yang di-*biru* ya
- yang di-*merah* sekedar untuk antisipasi kalau nama folder atau nama
filenya ada yang pakai spasi atau karakter special tertentu
*1. Ping memanfaatkan shell*
dim sFile as string, sAddress as string 'info file hasil ping
dan url yang di-ping
dim iFile as integer, sLine as string, lLine as long 'variabel kerja
baca file hasil ping
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init file hasil ping dan url yang di-ping
sfile=thisworkbook.path & "\res.txt" 'hasil ping disimpan di file
res.txt di path yang sama dengan workbook
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah ping dengan shell
'-> catatan : jika url-nya timeout, butuh waktu beberapa detik untuk
selesaikan proses,
' ping *1* kali saja
*shell "cmd /c ping " & sAddress & " -n 1 > """ & sFile & """", vbHide*
*application.wait now + timevalue("00:00:05")*
'baca file hasil ping (file res.txt dalam sFile) dengan open
lline=0 'baris hasil di sheet(1) masih 0
ifile=freefile 'generate nomor file
open sfile for input as ifile 'buka file
do while not eof(ifile) 'loop setiap baris dalam file sampai
akhir file
lline=lline+1 'set baris hasil bertambah 1
line input #ifile,sline 'ambil isi sebaris file dan
masukkan ke sline
thisworkbook.sheets(1).cells( lline , 1 ).value= "'" &
sline 'tulis ke cells hasil
loop
close ifile 'tutup file
kill sfile 'delete file
*** cara 1 ini menggunakan application.wait untuk memastikan bahwa proses
oleh baris shell dipastikan telah selesai lebih dulu sebelum mulai membaca
isi file hasil
*2. ping menggunakan wscript.shell* (supaya lebih pasti bahwa proses telah
selesai dan siap dibaca filenya)
dim sFile as string, sAddress as string 'info file hasil ping
dan url yang di-ping
dim iFile as integer, sLine as string, lLine as long 'variabel kerja
baca file hasil ping
*dim wsh as object*
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init file hasil ping dan url yang di-ping
sfile=thisworkbook.path & "\res.txt" 'hasil ping disimpan di file
res.txt di path yang sama dengan workbook
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah ping dengan shell
'-> catatan : jika url-nya timeout, butuh waktu beberapa detik untuk
selesaikan proses,
' ping *1* kali saja
*set wsh=createobject("WScript.Shell")wsh.run "cmd /c ping " & sAddress & "
-n 1 > **""" & sFile & "*
*""", 0,true*
'baca file hasil ping (file res.txt dalam sFile) dengan open
lline=0 'baris hasil di sheet(1) masih 0
ifile=freefile 'generate nomor file
open sfile for input as ifile 'buka file
do while not eof(ifile) 'loop setiap baris dalam file sampai
akhir file
lline=lline+1 'set baris hasil bertambah 1
line input #ifile,sline 'ambil isi sebaris file dan
masukkan ke sline
thisworkbook.sheets(1).cells( lline , 1 ).value= "'" &
sline 'tulis ke cells hasil
loop
close ifile 'tutup file
kill sfile 'delete file
*** cara 2 ini lebih pasti bahwa ketika proses ping telah selesai barulah
baca file hasil ping
fyi,
ping menggunakan ICMP dan beberapa url tidak mengijinkan akses dengan ICMP,
sehingga akan menghasilkan timeout, padahal jika url dibuka dengan browser
tetap akan terbuka alias tidak timeout. Contohnya, website Bank Indonesia
di www.bi.go.id
Dengan ping ke www.bi.go.id hasilnya akan timeout, tetapi di browser
ditulis url www.bi.go.id, browser akan membuka website Bank Indonesia.
Hal ini disebabkan karena ICMP di-disable oleh server Bank Indonesia,
tetapi browser di-Enable.
Jika maskud penggunaan ping untuk mengetahui url dapat diakses atau tidak,
maka bisa juga menggunakan cara lainnya, seperti followhyperlink.
Contoh :
*A. Pakai followhyperlink* (sayangnya, kalau url bisa diakses, akan membuka
url terebut di browser)
dim sAddress as string
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init url yang di-ping
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah followhyperlink
on error resume next 'trap error
*thisworkbook.followhyperlink "http://" & saddress*
'tulis status hasil
if err.number<>0 then
err.clear
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : Request
Timeout"
else
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : OK"
endif
on error goto 0 'kembalikan trap error ke default
*B. Pakai xlmHTTP*
dim sAddress as string
*dim sRes as string, oXML as object * 'variabel penyimpan response dan
object xmlhttp
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init url yang di-ping
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah panggil url
*set oxml=createobject("MSXML2.serverXMLHTTP")*
*oxml.open "GET", "http://" & saddress ,false*
*oxml.send*
*sres=oxml.responsetext*
'tulis status hasil
if err.number<>0 then
err.clear
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : Request
Timeout"
else
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : OK"
endif
on error goto 0 'kembalikan trap error ke default
Regards,
Kid
2016-09-14 9:24 GMT+07:00 'Heru Safrudin' fcprocessing.bisikediri@bisi.co.id
[belajar-excel] <belajar-excel@yahoogroups.com>:
>
>
> Dear be Exceller..
>
>
>
> Bisakah VBA mendapatkan hasil informasi ping ke dari alamat tertentu
>
> Contoh :
>
> Ping statistics for 123.456.789:
>
> Packets: Sent = 4, Received = 0, Lost = 4 (100% loss)
>
>
>
> Mohon pencerahannya
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
Bisa.
Untuk apa ya hasil ping nya ?
ya wis lah... untuk apa sajalah...
Asumsi : hasilnya ditulis di kolom A sheet pertama dalam tab sheet di
workbook berisi script
Peringatan :
- perhatikan dan bandingkan bagian yang di-*biru* ya
- yang di-*merah* sekedar untuk antisipasi kalau nama folder atau nama
filenya ada yang pakai spasi atau karakter special tertentu
*1. Ping memanfaatkan shell*
dim sFile as string, sAddress as string 'info file hasil ping
dan url yang di-ping
dim iFile as integer, sLine as string, lLine as long 'variabel kerja
baca file hasil ping
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init file hasil ping dan url yang di-ping
sfile=thisworkbook.path & "\res.txt" 'hasil ping disimpan di file
res.txt di path yang sama dengan workbook
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah ping dengan shell
'-> catatan : jika url-nya timeout, butuh waktu beberapa detik untuk
selesaikan proses,
' ping *1* kali saja
*shell "cmd /c ping " & sAddress & " -n 1 > """ & sFile & """", vbHide*
*application.wait now + timevalue("00:00:05")*
'baca file hasil ping (file res.txt dalam sFile) dengan open
lline=0 'baris hasil di sheet(1) masih 0
ifile=freefile 'generate nomor file
open sfile for input as ifile 'buka file
do while not eof(ifile) 'loop setiap baris dalam file sampai
akhir file
lline=lline+1 'set baris hasil bertambah 1
line input #ifile,sline 'ambil isi sebaris file dan
masukkan ke sline
thisworkbook.sheets(1).cells( lline , 1 ).value= "'" &
sline 'tulis ke cells hasil
loop
close ifile 'tutup file
kill sfile 'delete file
*** cara 1 ini menggunakan application.wait untuk memastikan bahwa proses
oleh baris shell dipastikan telah selesai lebih dulu sebelum mulai membaca
isi file hasil
*2. ping menggunakan wscript.shell* (supaya lebih pasti bahwa proses telah
selesai dan siap dibaca filenya)
dim sFile as string, sAddress as string 'info file hasil ping
dan url yang di-ping
dim iFile as integer, sLine as string, lLine as long 'variabel kerja
baca file hasil ping
*dim wsh as object*
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init file hasil ping dan url yang di-ping
sfile=thisworkbook.path & "\res.txt" 'hasil ping disimpan di file
res.txt di path yang sama dengan workbook
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah ping dengan shell
'-> catatan : jika url-nya timeout, butuh waktu beberapa detik untuk
selesaikan proses,
' ping *1* kali saja
*set wsh=createobject("WScript.Shell")wsh.run "cmd /c ping " & sAddress & "
-n 1 > **""" & sFile & "*
*""", 0,true*
'baca file hasil ping (file res.txt dalam sFile) dengan open
lline=0 'baris hasil di sheet(1) masih 0
ifile=freefile 'generate nomor file
open sfile for input as ifile 'buka file
do while not eof(ifile) 'loop setiap baris dalam file sampai
akhir file
lline=lline+1 'set baris hasil bertambah 1
line input #ifile,sline 'ambil isi sebaris file dan
masukkan ke sline
thisworkbook.sheets(1).cells( lline , 1 ).value= "'" &
sline 'tulis ke cells hasil
loop
close ifile 'tutup file
kill sfile 'delete file
*** cara 2 ini lebih pasti bahwa ketika proses ping telah selesai barulah
baca file hasil ping
fyi,
ping menggunakan ICMP dan beberapa url tidak mengijinkan akses dengan ICMP,
sehingga akan menghasilkan timeout, padahal jika url dibuka dengan browser
tetap akan terbuka alias tidak timeout. Contohnya, website Bank Indonesia
di www.bi.go.id
Dengan ping ke www.bi.go.id hasilnya akan timeout, tetapi di browser
ditulis url www.bi.go.id, browser akan membuka website Bank Indonesia.
Hal ini disebabkan karena ICMP di-disable oleh server Bank Indonesia,
tetapi browser di-Enable.
Jika maskud penggunaan ping untuk mengetahui url dapat diakses atau tidak,
maka bisa juga menggunakan cara lainnya, seperti followhyperlink.
Contoh :
*A. Pakai followhyperlink* (sayangnya, kalau url bisa diakses, akan membuka
url terebut di browser)
dim sAddress as string
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init url yang di-ping
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah followhyperlink
on error resume next 'trap error
*thisworkbook.followhyperlink "http://" & saddress*
'tulis status hasil
if err.number<>0 then
err.clear
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : Request
Timeout"
else
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : OK"
endif
on error goto 0 'kembalikan trap error ke default
*B. Pakai xlmHTTP*
dim sAddress as string
*dim sRes as string, oXML as object * 'variabel penyimpan response dan
object xmlhttp
thisworkbook.sheets(1).range("a:a").clearcontents 'hapus area penulisan
hasil
'init url yang di-ping
saddress="www.google.com" 'url yang di-ping, bisa juga ip address-nya
seperti untuk google bisa 111.95.240.85 (nslookup untuk list ip address
sebuah domain)
'perintah panggil url
*set oxml=createobject("MSXML2.serverXMLHTTP")*
*oxml.open "GET", "http://" & saddress ,false*
*oxml.send*
*sres=oxml.responsetext*
'tulis status hasil
if err.number<>0 then
err.clear
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : Request
Timeout"
else
thisworkbook.sheets(1).cells(1, 1).value = sAddress & " : OK"
endif
on error goto 0 'kembalikan trap error ke default
Regards,
Kid
2016-09-14 9:24 GMT+07:00 'Heru Safrudin' fcprocessing.bisikediri@bisi.co.id
[belajar-excel] <belajar-excel@yahoogroups.com>:
>
>
> Dear be Exceller..
>
>
>
> Bisakah VBA mendapatkan hasil informasi ping ke dari alamat tertentu
>
> Contoh :
>
> Ping statistics for 123.456.789:
>
> Packets: Sent = 4, Received = 0, Lost = 4 (100% loss)
>
>
>
> Mohon pencerahannya
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
Wed Sep 14, 2016 1:36 am (PDT) . Posted by:
y.roni35
Saya punya file vba excel ketika digunakan muncul Run Time Eror 75.
Kira2 kesalahan yang harus saya perbaiki terletak dmn. makasih
Kira2 kesalahan yang harus saya perbaiki terletak dmn. makasih
============================================================
Pojok Lowongan Kerja yang disediakan milis :
http://milis-belajar-excel.1048464.n5.nabble.com/Pojok-Lowongan-Kerja-f5725753.html
*** Posting lowongan kerja : ke link tersebut dan klik New Topic
============================================================
bergabung ke milis (subscribe), kirim mail kosong ke: belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke: belajar-excel@yahoogroups.com
berkunjung ke web milis : http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran : http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di : http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe), kirim mail kosong ke : belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
Pojok Lowongan Kerja yang disediakan milis :
http://milis-belajar-excel.1048464.n5.nabble.com/Pojok-Lowongan-Kerja-f5725753.html
*** Posting lowongan kerja : ke link tersebut dan klik New Topic
============================================================
bergabung ke milis (subscribe), kirim mail kosong ke: belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke: belajar-excel@yahoogroups.com
berkunjung ke web milis : http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran : http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di : http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe), kirim mail kosong ke : belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
Tidak ada komentar:
Posting Komentar