Soru run time error 3079 hatası?

[s.savas]

Merhaba arkadaşlar.
Sorunumu paylaşmadan önce bütün forumdaşların kandilini kutluyorum.
Sorunuma gelince access veritabanına ağdan bağlanmaya çalışırken run time error 3079 hatası alıyorum.
Evdeki diğer bilgisayarda d sürücüsünde cc isimli bir klasörü paylaşım izinlerini yaparak diğer bilgisayardan bağlantı yapmaya çalışıyorum.

Sub BAGLANTI()

Dim Yoll As String
   If Yoll = "" Then Yoll = ThisWorkbook.Path
   DatabasePath = Yoll & "\\192.168.1.11\cc\REHBER.mdb"
   On Error Resume Next
   Set baglan = CreateObject("ADODB.Connection")
If Val(Application.Version) >= 12 Then
    baglan.Provider = "Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=şifre;"
Else
     baglan.Provider = "Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=şifre;"
End If
     baglan.ConnectionString = DatabasePath
    baglan.Open
End Sub

Aşağıdaki hatayı veriyor. Yardımlarınızı rica ediyorum.

 

[askm]

Sanırım
If Yoll = "" Then Yoll = ThisWorkbook.Path
DatabasePath = Yoll & "\\192.168.1.11\cc\REHBER.mdb"
kısmında bir sorun var. Dosya yolu hem excelin içerisinde bulunduğu klasörde yazmışsınız, hem de ip adres vermişsiniz.

 

[s.savas]

Sanırım
If Yoll = "" Then Yoll = ThisWorkbook.Path
DatabasePath = Yoll & "\\192.168.1.11\cc\REHBER.mdb"
kısmında bir sorun var. Dosya yolu hem excelin içerisinde bulunduğu klasörde yazmışsınız, hem de ip adres vermişsiniz.

Evet.
Program kurgulanırken excell ve veritabanının birlikte aynı yerde bulunacağı öngörülmüştü.
Şu şekilde yapınca da hata vermedi ancak form açılmadan excel arka planda çalışıyor.

Sub BAGLANTI()

Dim Yoll As String
      DatabasePath = "\\192.168.1.11\cc\REHBER.mdb"
   On Error Resume Next
   Set baglan = CreateObject("ADODB.Connection")
If Val(Application.Version) >= 12 Then
    baglan.Provider = "Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=şifre;"
Else
     baglan.Provider = "Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=şifre;"
End If
     baglan.ConnectionString = DatabasePath
    baglan.Open
End Sub

 

[askm]

Form açmak için userform.show kodu eklemeniz gerek.

 

[s.savas]

Bağlantı sağlandıktan sonra kod bloğunun devamında form açılışı için kod mevcut hocam.

Private baglan As Object, rs As Object
Dim adoCN As Object
Dim strSQL As String
Dim CurrRec As String
Dim DatabasePath As String
'access veri tabanı bağlantısı bitiş

Sub BAGLANTI()

Dim Yoll As String
   'If Yoll = "" Then Yoll = ThisWorkbook.Path
   If Yoll = "" Then Yoll = "\\192.168.1.11\cc\REHBER.mdb"
   DatabasePath = Yoll & "\\192.168.1.11\cc\REHBER.mdb"
   On Error Resume Next
   Set baglan = CreateObject("ADODB.Connection")
 If Val(Application.Version) >= 12 Then
    baglan.Provider = "Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=sifre;"
 Else
     baglan.Provider = "Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=sifre;"
 End If
     baglan.ConnectionString = DatabasePath
    baglan.Open
End Sub

Private Sub ComboBox2_Change()
If ComboBox2.Text = "Kurum Personeli Girişi" Then
TextBox1.Text = "KURUM MENSUBU"
Label1 = "T.C KİMLİK"
Me.TextBox2.PasswordChar = ""
ElseIf ComboBox2.Text = "Kayıtlı Kullanıcı Girişi" Then
TextBox1.Text = ""
Label1 = "ŞİFRE"
ElseIf ComboBox2.Text = "Şifre değiştir" Then
UserForm1.Hide
UserForm6.Show
ElseIf ComboBox2.Text = "ÇIKIŞ" Then
CommandButton6_Click
End If

End Sub
Private Sub CommandButton1_Click()

Select Case TextBox1.Text
Case "KURUM MENSUBU"
If TextBox2.Text = Empty Then MsgBox "Lütfen Kimlik Numaranızı Giriniz.", 64, "EVN": Exit Sub

Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

Call BAGLANTI
personel = Me.TextBox2.Value
rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK='" & TextBox2.Text & "';", baglan, 1, 1
        
If Not rs.RecordCount >= 1 Then
MsgBox "Kayıtlı değilsiniz", vbInformation, "Süleyman Savaş"
temizle
TextBox1.SetFocus
Exit Sub
End If


Sheets("anasayfa").Range("AY1") = TextBox2  't.c kimlik
Sheets("anasayfa").Range("AY2") = "3"  'yetki
          
rs.Close
Me.Hide
UserForm2.Show
End Select
        
Select Case TextBox1.Text
Case Is <> "KURUM MENSUBU"
If TextBox1.Text = Empty Then MsgBox "Lütfen kullanıcı adını giriniz.", 64, "EVN": Exit Sub

Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")


Call BAGLANTI
personel = Me.TextBox2.Value
rs.Open "select * from [logindata] WHERE [logindata].kullanici='" & TextBox1.Text & "';", baglan, 1, 1
If Not rs.RecordCount >= 1 Then
MsgBox "Kayıtlı değilsiniz", vbInformation, "Süleyman Savaş"
temizle
TextBox1.SetFocus
Exit Sub
End If

If Me.TextBox2.Text = rs("sifre") Then

Sheets("anasayfa").Range("AY1") = TextBox1
Sheets("anasayfa").Range("AY2") = rs("yetki")
Else
MsgBox "Kullanıcı Adı veya Şifre Hatalı...    ", vbCritical, "Hata!"
Exit Sub
End If

rs.Close
Me.Hide
UserForm2.Show

End Select
End Sub
Private Sub CommandButton6_Click()
Dim Onay As Byte
Onay = MsgBox("Program kapatılacaktır onaylıyor musunuz ?" & vbCrLf & vbCrLf & _
"EVET    Dosyayı kaydedip kapatır." & vbCrLf & _
"HAYIR   Dosyayı kaydetmeden kapatır." & vbCrLf & _
"İPTAL   İşlemi iptal eder.", vbCritical + vbYesNoCancel, "Dikkat !")
 
If Onay = vbYes Then
If Excel.Application.Windows.Count > 1 Then
ThisWorkbook.Save
ThisWorkbook.Close
Else
ThisWorkbook.Save
Application.Quit
End If
 
ElseIf Onay = vbNo Then
Application.DisplayAlerts = False
If Excel.Application.Windows.Count > 1 Then
ThisWorkbook.Close
Else
Application.Quit
End If
End If
End Sub


Private Sub TextBox1_Change()
TextBox1.Text = UCase(Replace(Replace(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ"), "I", "I"), "İ", "İ"))
End Sub

Private Sub UserForm_Activate()
Dim X As Integer
Dim current As Variant
Dim Y As String
TextBox1.ForeColor = RGB(0, 120, 0)
TextBox2.ForeColor = RGB(0, 120, 0)
TextBox1.BorderColor = RGB(0, 0, 0)
TextBox2.BorderColor = RGB(0, 0, 0)
Me.TextBox2.BackColor = RGB(0, 102, 0)
Me.TextBox1.BackColor = RGB(0, 102, 0)
Me.Caption = "REHBER / AJANDA LOGİN"
Call TextBox1_Enter
Call TextBox2_Enter
Y = UserForm1.Caption
UserForm1.Caption = ""
For X = 0 To Len(Y)
    If X = 0 Then
    UserForm1.Caption = ""
    current = Timer
        Do While Timer - current < 0.1
           DoEvents
        Loop
   GoTo bitti
Else: End If
UserForm1.Caption = Left(Y, X)
current = Timer
Do While Timer - current < 0.05
DoEvents
Loop
bitti:
Next X

'TextBox1.Text = ""
ComboBox2.Clear
ComboBox2.AddItem "Kayıtlı Kullanıcı Girişi"
ComboBox2.AddItem "Kurum Personeli Girişi"
ComboBox2.AddItem "Şifre değiştir"
ComboBox2.AddItem "ÇIKIŞ"
ComboBox2.Text = "Kayıtlı Kullanıcı Girişi"


Application.Visible = False

End Sub

Private Sub UserForm_Initialize()
Dim hWnd As Long
hWnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF

Me.TextBox2.PasswordChar = "*"
Application.Visible = False

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Label5.Visible = False
If TextBox1.Text = "Kullanıcı Giriniz" Then
TextBox1.Text = ""
TextBox1.ForeColor = &H0&
ElseIf TextBox1.Text = "" Then
TextBox1.Text = "Kullanıcı Giriniz"
TextBox1.ForeColor = RGB(0, 120, 0)
End If
End Sub

Private Sub TextBox1_Enter()
If TextBox1.Text = "Kullanıcı Giriniz" Then
TextBox1.Text = ""
TextBox1.ForeColor = &H0&
ElseIf TextBox1.Text = "" Then
TextBox1.Text = "Kullanıcı Giriniz"
TextBox1.ForeColor = RGB(0, 120, 0)
End If
End Sub
 

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
TextBox1.BorderColor = RGB(255, 255, 255)
TextBox2.BorderColor = RGB(0, 0, 0)
End Sub



Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
TextBox1.BorderColor = RGB(0, 0, 0)
TextBox2.BorderColor = RGB(0, 0, 0)
End Sub
 

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Label5.Visible = False
If TextBox2.Text = "Parola Giriniz" Then
TextBox2.Text = ""
TextBox2.ForeColor = &H0&
TextBox2.PasswordChar = "*"
ElseIf TextBox2.Text = "" Then
TextBox2.Text = "Parola Giriniz"
TextBox2.ForeColor = RGB(0, 120, 0)
TextBox2.PasswordChar = ""
End If
End Sub

Private Sub TextBox2_Enter()
If TextBox2.Text = "Parola Giriniz" Then
TextBox2.Text = ""
TextBox2.ForeColor = &H0&
TextBox2.PasswordChar = "*"
ElseIf TextBox2.Text = "" Then
TextBox2.Text = "Parola Giriniz"
TextBox2.ForeColor = RGB(0, 120, 0)
TextBox2.PasswordChar = ""
End If
End Sub
 

Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
TextBox2.BorderColor = RGB(255, 255, 255)
TextBox1.BorderColor = RGB(0, 0, 0)
End Sub




Private Sub aUserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If Application.Visible = True Then Exit Sub
If MsgBox("DOSYA KAPATILACAK ONAYLIYORMUSUNUZ?", vbYesNo) = vbYes Then
ActiveWorkbook.Save
Unload Me
Application.Quit
Else
Cancel = 1
End If
End Sub

Private Sub temizle()
TextBox1.Text = ""
TextBox2.Text = ""
End Sub