Anónimo
Macro en Excel que indique conexión a internet
Resulta que tengo un pequeño programa en excel de ordenes de compra, que logre subir a un servidor, para que de esa forma.. Cualquier sucursal nuestra pueda hacer ordenes y mantener un solo coorelativo...
Esta es la macro que tengo para bajar el archivo:
Dim EjecBat
EjecBat = Shell("C:\compras\ftpbaja.bat")
Workbooks.Open Filename:= _
"C:\compras\OC.xlsm"
End Sub
Si te fijas aquí bajo el archivo del servidor y luego lo abro, sin embargo cuando no tengo conexión a internet me abre el archivo que quedo en mi pc o sea el antiguo...
Es por eso que necesito una macro que me arroje error cuando mi pc no este conectado.. Así podre hacer ordnes de compra siempre y cuendo este conectada.
Esta es la macro que tengo para bajar el archivo:
Dim EjecBat
EjecBat = Shell("C:\compras\ftpbaja.bat")
Workbooks.Open Filename:= _
"C:\compras\OC.xlsm"
End Sub
Si te fijas aquí bajo el archivo del servidor y luego lo abro, sin embargo cuando no tengo conexión a internet me abre el archivo que quedo en mi pc o sea el antiguo...
Es por eso que necesito una macro que me arroje error cuando mi pc no este conectado.. Así podre hacer ordnes de compra siempre y cuendo este conectada.
1 Respuesta
Respuesta de Juan Carlos González Chavarría
1
Me parece que la mejor solución sería verificar la IP del Router. Puedes utilizar esta macro que me encontré. Pones en A1 la IP y ejecutas la macro.
Option Explicit
Private Declare Function GetRTTAndHopCount Lib "iphlpapi.dll" _
(ByVal iDestIPAddr As Long, _
ByRef iHopCount As Long, _
ByVal iMaxHops As Long, _
ByRef iRTT As Long) As Long
Private Declare Function inet_addr Lib "wsock32.dll" _
(ByVal cp As String) As Long
Sub TestPings()
Dim cell As Range
Dim astr() As String
For Each cell In Intersect(ActiveSheet.UsedRange, Columns(1))
astr = Split(cell.Value, ".")
If UBound(astr) = 3 Then
cell.Select
cell.Interior.ColorIndex = xlNone
cell.Interior.ColorIndex = IIf(Ping(cell.Text, 20), 4, 3)
End If
Next
End Sub
Public Function Ping(sIPadr As String, iMaxHops As Long) As Boolean
' Based on an article on CodeGuru by Bill Nolde
' Implemented in VBA in Nov 2002 by G. Wirth, Ulm, Germany
Const SUCCESS As Long = 1
Dim iIPadr As Long
Dim iHopCount As Long
Dim iRTT As Long
iIPadr = inet_addr(sIPadr)
Ping = (GetRTTAndHopCount(iIPadr, iHopCount, iMaxHops, iRTT) = SUCCESS)
Debug.Print "IP Address ....... " & iIPadr & vbLf _
& "HopCount ......... " & iHopCount & vbLf _
& " Round trip, ms ... " & iRTT
End Function
[email protected]
Option Explicit
Private Declare Function GetRTTAndHopCount Lib "iphlpapi.dll" _
(ByVal iDestIPAddr As Long, _
ByRef iHopCount As Long, _
ByVal iMaxHops As Long, _
ByRef iRTT As Long) As Long
Private Declare Function inet_addr Lib "wsock32.dll" _
(ByVal cp As String) As Long
Sub TestPings()
Dim cell As Range
Dim astr() As String
For Each cell In Intersect(ActiveSheet.UsedRange, Columns(1))
astr = Split(cell.Value, ".")
If UBound(astr) = 3 Then
cell.Select
cell.Interior.ColorIndex = xlNone
cell.Interior.ColorIndex = IIf(Ping(cell.Text, 20), 4, 3)
End If
Next
End Sub
Public Function Ping(sIPadr As String, iMaxHops As Long) As Boolean
' Based on an article on CodeGuru by Bill Nolde
' Implemented in VBA in Nov 2002 by G. Wirth, Ulm, Germany
Const SUCCESS As Long = 1
Dim iIPadr As Long
Dim iHopCount As Long
Dim iRTT As Long
iIPadr = inet_addr(sIPadr)
Ping = (GetRTTAndHopCount(iIPadr, iHopCount, iMaxHops, iRTT) = SUCCESS)
Debug.Print "IP Address ....... " & iIPadr & vbLf _
& "HopCount ......... " & iHopCount & vbLf _
& " Round trip, ms ... " & iRTT
End Function
[email protected]