• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

    Giriş yap veya Şimdi kayıt ol

Çözüldü İnternet Bağlantısı Msgbox Yardımı Hk.

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
E

Erdogan34

Yeni Üye
Katılım
3 Eki 2022
Mesajlar
85
Çözümler
1
Aldığı beğeni
22
Excel V
Office 2013 TR
Merhabalar,
Excel dosyam aşağıdaki makro ile internete bağlı iken çalışsın ancak bağlı olmadığında MsgBox "Dosyayı açmak için lütfen cihazınızın internet bağlantısını aktif hale getirin" mesajı yazsın istiyorum. Kodum internet aktifken yapmasını istediğim herşeyi yapıyor ancak bilgisayarın internet bağlantısı kapalı iken Msgbox gelmesini sağlayamadım. Desteğiniz ricasıyla.

C++: 
Private Sub Workbook_Open()

   'Test - 05/10/2022
    Dim MyMsg As String, oSystem As Object, Item As Object
        Dim objHttp As Object
            Set objHttp = CreateObject("MSXML2.XMLHTTP")
    objHttp.Open "GET", "http://myip.dnsomatic.com", False
    objHttp.Send
        Set oSystem = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
            For Each Item In oSystem
    strMsg = ""
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled = 'True'")
    For Each IPConfig In IPConfigSet
        If Not IsNull(IPConfig.IPAddress) Then
            For i = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                If Not InStr(IPConfig.IPAddress(i), ":") > 0 Then
                    strMsg = strMsg & IPConfig.IPAddress(i) & " Merkez IP numaralı" & vbCrLf & objHttp.ResponseText & " Dış IP numaralı " & vbCrLf & Item.Name & " kullanıcısına ait" & vbCrLf & " Açılış bilgisi merkeze iletildi."
                End If
            Next
        End If
    Next
     Set oSystem = Nothing
     Set objHttp = Nothing
     Next
    MsgBox strMsg


End Sub
 
Çözüm
A
Bir modüle aşağıdaki kodu
Kod: 
Private Declare PtrSafe Function InternetGetConnectedStateEx Lib "wininet.dll" _
(ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _
ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
Public Function CheckInternetConnection() As Boolean
    Dim Aux As String * 255
    Dim Kontrol As Long
    Kontrol = InternetGetConnectedStateEx(Kontrol, Aux, 254, 0)
    If Kontrol = 1 Then
        CheckInternetConnection = True
    Else
        CheckInternetConnection = False
    End If
End Function
Başka bir modüle aşağıdaki kodu yapıştırarak deneyin.
Kod: 
Sub TEST()
    If (CheckInternetConnection = False) Then
    MsgBox "İnternet bağlantısı şu anda kurulamıyor." _
    & Chr(10) & "Lütfen daha...
Tarihe göre sırala Oylara göre sırala
modüle yapıştırın İnternet bağlantı kontrolü
C++: 
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Public Function GetInternetConnectedState() As Boolean
  GetInternetConnectedState = InternetGetConnectedState(0&, 0&)
End Function

Sub Get_State()
If GetInternetConnectedState = False Then
MsgBox "İnternete bağlı olmalısınız"
End If
End Sub
 
Olumlu oy 0 Negatif oyla
Adnan' Alıntı:
modüle yapıştırın İnternet bağlantı kontrolü
C++: 
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Public Function GetInternetConnectedState() As Boolean
  GetInternetConnectedState = InternetGetConnectedState(0&, 0&)
End Function

Sub Get_State()
If GetInternetConnectedState = False Then
MsgBox "İnternete bağlı olmalısınız"
End If
End Sub
Genişletmek için tıkla...

Private Declare Function InternetGetConnectedState Lib "wininet.dll" _ (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Bu kısım hata veriyor.
 
Olumlu oy 0 Negatif oyla
ofis 64 bit mi
 
Olumlu oy 0 Negatif oyla
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long) As Long kodunu silin yerine alttaki kodu yazın


Kod: 
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function InternetGetConnectedState _
            Lib "wininet.dll" (lpdwFlags As LongPtr, _
            ByVal dwReserved As Long) As Boolean
#Else
    Private Declare Function InternetGetConnectedState _
            Lib "wininet.dll" (lpdwFlags As Long, _
            ByVal dwReserved As Long) As Boolean
#End If
 
Olumlu oy 0 Negatif oyla
Adnan' Alıntı:
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long) As Long kodunu silin yerine alttaki kodu yazın


Kod: 
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function InternetGetConnectedState _
            Lib "wininet.dll" (lpdwFlags As LongPtr, _
            ByVal dwReserved As Long) As Boolean
#Else
    Private Declare Function InternetGetConnectedState _
            Lib "wininet.dll" (lpdwFlags As Long, _
            ByVal dwReserved As Long) As Boolean
#End If
Genişletmek için tıkla...
Hocam maalesef çözüme ulaşamadım. Eke bir dosya ekledim. Bu dosyaya istediğim eğer internete bağlı değilse İnternete bağlanmalısınız Msgbox'u gelsin dosya açılmasın. Eğer bağlıysa standart şekilde açılsın. Sizi de çok uğraştırdım ama yapabilirseniz sevinirim. Aksi takdirde çözümü başka bir yöntemle aramaya çalışacağım.

Saygımlarımla,
 

Ekli dosyalar

Olumlu oy 0 Negatif oyla
Bir modüle aşağıdaki kodu
Kod: 
Private Declare PtrSafe Function InternetGetConnectedStateEx Lib "wininet.dll" _
(ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _
ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
Public Function CheckInternetConnection() As Boolean
    Dim Aux As String * 255
    Dim Kontrol As Long
    Kontrol = InternetGetConnectedStateEx(Kontrol, Aux, 254, 0)
    If Kontrol = 1 Then
        CheckInternetConnection = True
    Else
        CheckInternetConnection = False
    End If
End Function
Başka bir modüle aşağıdaki kodu yapıştırarak deneyin.
Kod: 
Sub TEST()
    If (CheckInternetConnection = False) Then
    MsgBox "İnternet bağlantısı şu anda kurulamıyor." _
    & Chr(10) & "Lütfen daha sonra tekrar deneyiniz.", vbCritical, "Dikkat !"
    End If
End Sub
 
Olumlu oy 1 Negatif oyla
Çözüm
Üstte belirtilen kodu modüle, aşağıdakini de açılış kodunun içine eklediğimde çalıştı. Sadece Msgbox geliyor ancak dosya açılmasın noktası olmuyordu. Aşağıdaki kodu şu şekilde düzenlediğimde tam da istediğim gibi oldu. Desteğiniz için çok teşekkür ederim.

C++: 
Sub TEST()
    If (CheckInternetConnection = False) Then
    MsgBox "İnternet bağlantısı şu anda kurulamıyor." _
    & Chr(10) & "Lütfen daha sonra tekrar deneyiniz.", vbCritical, "Dikkat !"
    Application.Quit
    End If
End Sub
 
Olumlu oy 0 Negatif oyla
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst