Ado Bağlantı Makrosu

hlojan · 2 Mayıs 2018

Merhabalar

Bir sürü bağlantı makrom var. Herbirinde ayrı ayrı bağlantı kodları yazıyorum.

Ortak bir Bağlantı makrosu yapsam . Diğer makrolarda çağırsam

Örnek Kodlarım

Kod:

'*****************************************
'              CİHAZ ARA MODÜLÜ                              *
'*****************************************

'************TANIMLAMA***********************
Dim wb As Workbook
Dim ws As Worksheet
Dim bag, rs As Object
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Anasayfa")
Set bag = New ADODB.Connection
Set rs = New ADODB.Recordset
'************TANIMLAMA SON*******************



On Error GoTo sertsave
'***********BAĞLANTI**********************
server_name = "**********"
database_name = "****"
User_ID = "*******"
Password = "*****"
port = "*******"
bag.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & server_name & _
                    ";Port=" & port & _
                    ";Database=" & database_name & _
                    ";User=" & User_ID & _
                    ";Password=" & Password & _
                    ";Option=4;" & _
                    ";CharSet=latin5;"
'***********BAĞLANTI SON******************


'***************SORGU*********************
rs.Open "select * from cihaz where kod='" & ws.Range("hkod") & "' and sira=" & CDbl(ws.Range("hsira")) & ";", bag, 1, 1
'**************SORGU SON******************



'*************** İŞLEM *******************

If rs.EOF Then
MsgBox "CİHAZ BULUNAMADI. Eski Database kontrol ediliyor"
rs.Close
bag.Close
sertsave:
yol = "B:\mDATA.accdb"
bag.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
'**************************************************************************************
rs.Open "select * from [cihaz] where kod='" & Range("hkod").Value & "' and sira=" & CDbl(Range("hsira").Value) & ";", bag, 1, 1
'**************************************************************************************
If rs.RecordCount > 0 Then
 On Error Resume Next
ws.Range("hmarka").Value = "-"
ws.Range("hmodel").Value = "-"
ws.Range("hseri").Value = "-"
ws.Range("hmustno").Value = "-"
ws.Range("hmarka").Value = UCase(Replace(Replace(rs("marka"), "i", "İ"), "ı", "I"))
ws.Range("hmodel").Value = UCase(Replace(Replace(rs("model"), "i", "İ"), "ı", "I"))
ws.Range("hseri").Value = UCase(Replace(Replace(rs("seri"), "i", "İ"), "ı", "I"))
ws.Range("hmustno").Value = UCase(Replace(Replace(rs("musterino"), "i", "İ"), "ı", "I"))

MsgBox " Cihaz bilgileri kontrol edin ve kaydedin"
Else
MsgBox "CİHAZ KAYITLI DEĞİL ! LÜTFEN BİLGİLERİ ELLE DOLDURUN VE KAYIT EDİN"
End If
rs.Close
bag.Close

Else

ws.Range("hmarka").Value = rs("marka").Value
ws.Range("hmodel").Value = rs("model").Value
ws.Range("hseri").Value = rs("seri").Value
ws.Range("hmustno").Value = rs("mustno").Value



MsgBox "CihazBulundu"
rs.Close
bag.Close
End If

'************** İŞLEM SON *****************



'****************BAĞLANTI KAPAT ***********

Set rs = Nothing: Set bag = Nothing
'******************************************

Ben bunu her makromda yazıyorum. İsteğim

Baglan Makrosu yazıp

Her Makronun başına Bağlan yazıp Myql bağlanmak

Makro sonundada çıkmak

Yardımlarınızı bekliyorum

hlojan · 4 Mayıs 2018

Çözüm bulamadım hala

Murat OSMA · 5 Mayıs 2018

Boş bir modül içerisine bağlantı kodlarınızı yazın.

Örneğin;

Kod:

[SIZE="2"]
Public bag As Object  
Public rs As Object

Sub [COLOR="Red"]baglan[/COLOR]()

' [COLOR="Blue"]Bağlantı kodları[/COLOR]

End Sub[/SIZE]

Prosedür içerisinden de Call baglan diyerek çağırabilirsiniz.

hlojan · 5 Mayıs 2018

Kod:

Public bag As Object
Public rs As Object

Sub baglan()

Set bag = New ADODB.Connection
Set rs = New ADODB.Recordset
'************TANIMLAMA SON*******************




'***********BAĞLANTI**********************
server_name = ""
database_name = ""
User_ID = ""
Password = ""
port = ""
bag.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & server_name & _
                    ";Port=" & port & _
                    ";Database=" & database_name & _
                    ";User=" & User_ID & _
                    ";Password=" & Password & _
                    ";Option=4;" & _
                    ";CharSet=latin5;"

End Sub
Sub dene()
Call baglan
rs.Open "select * from firma where kod='" & ws.Range("hkod") & "';", bag, 1, 1

MsgBox rs("firma")

End Sub

Hata aldım.
User Defined type not defined
Hata Kaynağı " ADODB.Connection"

hlojan · 5 Mayıs 2018

Kod:

Dim bag As ADODB.Connection
Dim rs As ADODB.Recordset
Dim kayit As Long, i As Long, a As Long

Function Baglan()
server_name = " "
database_name = " "
User_ID = " "
Password = " "
port = "3306"
bag.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & server_name & _
                    ";Port=" & port & _
                    ";Database=" & database_name & _
                    ";User=" & User_ID & _
                    ";Password=" & Password & _
                    ";Option=4;" & _
                    ";CharSet=latin5;"
End Function

Private Sub ARA()


Baglan


'***********BAĞLANTI SON******************


'***************SORGU*********************
rs.Open "select * from [Musteri] where kod='KOR';", bag, 1, 1

MsgBox UCase(Replace(Replace(rs("firma"), "i", "İ"), "ı", "I"))

rs.Close
End Sub

Buda hata veriyor. "bag As ADODB.Connection"

Murat OSMA · 5 Mayıs 2018

Boş modüle bu kodları yapıştırın..

Kod:

[SIZE="2"]Public bag As Object, rs As Object
Public server_name As String, database_name As String
Public User_ID As String, Password As String, port
Public Sub baglan()
    server_name = "**********"
    database_name = "****"
    User_ID = "*******"
    Password = "*****"
    port = "*******"
    bag.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & server_name & _
    ";Port=" & port & _
    ";Database=" & database_name & _
    ";User=" & User_ID & _
    ";Password=" & Password & _
    ";Option=4;" & _
    ";CharSet=latin5;"
End Sub

''' Ana kodlardan da bu satırı kaldırın...
Dim bag, rs As Object

''' Şimdi bağlanmanız gereken yerde [COLOR="Red"]Call baglan[/COLOR] yazabilirsiniz. [/SIZE]

Haluk · 6 Mayıs 2018

hlojan' Alıntı:
Hata aldım.
User Defined type not defined
Hata Kaynağı " ADODB.Connection"

Murat Bey, soruyu soran arkadaşın kodlarının olduğu dosyayı göremedik ama;

Early binding tercih edildiyse "bag" ve "rs" nesneleri için ilgili referansların eklenmesi, ya da late binding tercih edildiyse CreateObject ile oluşturmak lazım.... diye düşünüyorum. Verdiği hataya göre; orjinal kodlarda sanki early binding tercih edilmiş ancak referans eklenmemiş, sizin kodlarda ise late binding kullanıyorsunuz ama bir yerlerde CreateObject ile bu nesnelerin oluşturulması gerekiyor gibi geldi bana.

Dosyayı görmediğim için yanılıyor olabilirim tabii, selamlar.

.

Murat OSMA · 6 Mayıs 2018

Selâmlar Haluk Bey,

İlk mesaj harici diğer mesajları okumadım açıkçası.
Hata alındığı söylenince sadece olması gerekenleri belirttim.

Uygulanacak yöntem konusunda açıklamalarınıza katılıyorum elbette.
Sn. hlojan'ın Early Binding yöntemini tercih ettiğini düşünüyorum... bu şekilde düşünürsek de önerdiğim kodların çalışmasında bir sorun yaşamayacaktır.

Deneyip sonucu bildirirse net bir çözüm sunarız.

Saygılar

hlojan · 6 Mayıs 2018

Murat Bey Denedim Çalışmadı
Hata : " run time error "91" > object variable or with block variable not set "

Hata kaynağı seçmedi.

Haluk beyin anlattıklarını okudum . Vba bilgim dışında bir konu.

Özetle tekrar anlatayım. Kaydet Değiştir Bul gibi farklı 8 tane makrom var. Her defasında Ado kodlarını tekrarlıyorum.

Ado bağlantısında Mysql kullandığımdan örnek dosya koyamıyorum.

Sürekli tekrarladığım kodlar aşağıdaki gibi

Kod:

'*****************************************
'*                    FİRMA BUL MODÜLÜ                    *
'*****************************************

'************TANIMLAMA***********************
Dim wb As Workbook
Dim ws As Worksheet
Dim bag, rs As Object
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Anasayfa")
Set bag = New ADODB.Connection
Set rs = New ADODB.Recordset
'************TANIMLAMA SON*******************




'***********BAĞLANTI**********************
server_name = "****"
database_name = "****"
User_ID = "***"
Password = "***"
port = "**"
bag.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & server_name & _
                    ";Port=" & port & _
                    ";Database=" & database_name & _
                    ";User=" & User_ID & _
                    ";Password=" & Password & _
                    ";Option=4;" & _
                    ";CharSet=latin5;"
'***********BAĞLANTI SON******************

'****************SORGU*********************
rs.Open "select * from firma where kod='" & ws.Range("hkod") & "';", bag, 1, 1
'**************SORGU SON******************


ws.Range("hfirma").Value = ""
ws.Range("hadres").Value = ""
ws.Range("hdosya").Value = ""
ws.Range("hfirma").Value = UCase(Replace(Replace(rs("firma"), "i", "İ"), "ı", "I"))
ws.Range("hadres").Value = UCase(Replace(Replace(rs("adres"), "i", "İ"), "ı", "I"))
ws.Range("hdosya").Value = UCase(Replace(Replace(rs("dosya"), "i", "İ"), "ı", "I"))




'************** İŞLEM SON *****************



'****************BAĞLANTI KAPAT ***********

Set rs = Nothing: Set bag = Nothing
End Sub

ben bunu her makroda tekrarlamak istemiyorum.

İnternette çok araştırdım

Function olarak yazıyorlar . Öylede çözemedim.
Gerçekten sıkıştım bu konuda

Bir ayrıntıda şu. Sizin çözümünüzde önemlimi bilmiyorum. Ben makro kodlarımı PERSONAL.XLSB de çalıştırıyorum. 100 e yakın excel kalıbım var. Ortak kod kaynağı gibi kullanıyorum

Kod:

Application.Run ("PERSONAL.XLSB!ckaydet")

Bu sayede kod güncellemerim bütün kalıblarımda geçerli oluyor

Murat OSMA · 7 Mayıs 2018

hlojan' Alıntı:
Haluk beyin anlattıklarını okudum . Vba bilgim dışında bir konu.

Merhabalar,

Haluk Bey'in verdiği bilgileri, bilgim dışında diyerek geçmemenizi öneririm.

VBA'ya başlamadan önce yazdığınız tüm bu kodlar hep bilginiz dışındaydı değil mi?
Oysa şimdi teknik konular haricinde kendiniz bir şeyler yapabilir durumdasınız.
Size nacizâne önerim; adım atmaktan korkmayın! Yeni bilgiler edinmekten geri durmayın.
Yeri gelecek, öğrendiğiniz bir konu sizin sıçrama yapmanıza sebep olacak.

Aşağıdaki kodları boş bir modüle yapıştırın.
Bağlanmak istediğiniz yerde de Call baglan dersiniz.

Kod:

[SIZE="2"]Public wb As Workbook, ws As Worksheet, bag As Object, rs As Object
Public server_name As String, database_name As String
Public User_ID As String, Password As String, port

Public Sub baglan()
'*****************************************
'*                    FİRMA BUL MODÜLÜ                    *
'*****************************************

'************TANIMLAMA***********************

'************TANIMLAMA SON*******************
'***********BAĞLANTI**********************
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Anasayfa")
Set bag = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
server_name = "****"
database_name = "****"
User_ID = "***"
Password = "***"
port = "**"
bag.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & server_name & _
                    ";Port=" & port & _
                    ";Database=" & database_name & _
                    ";User=" & User_ID & _
                    ";Password=" & Password & _
                    ";Option=4;" & _
                    ";CharSet=latin5;"
'***********BAĞLANTI SON******************
'****************SORGU*********************
rs.Open "select * from firma where kod='" & ws.Range("hkod") & "';", bag, 1, 1
'**************SORGU SON******************
ws.Range("hfirma").Value = ""
ws.Range("hadres").Value = ""
ws.Range("hdosya").Value = ""
ws.Range("hfirma").Value = UCase(Replace(Replace(rs("firma"), "i", "İ"), "ı", "I"))
ws.Range("hadres").Value = UCase(Replace(Replace(rs("adres"), "i", "İ"), "ı", "I"))
ws.Range("hdosya").Value = UCase(Replace(Replace(rs("dosya"), "i", "İ"), "ı", "I"))
'************** İŞLEM SON *****************
'****************BAĞLANTI KAPAT ***********

Set rs = Nothing: Set bag = Nothing
End Sub[/SIZE]

hlojan · 7 Mayıs 2018

Yine hata verdi

Ben örnek dosya hazırladım. Access kullandım . ordan düzenlerseniz ben uyarlarım.

Bu arada tavsiyeleriniz için teşekkür ederim . 3 senedir bu site sayesinde msgbox "Merhaba" dan buralara geldim. Ado hayranı oldum. Sizin Excel Arşivinizi satın aldım.

Haluk beyin bahsettiği konuyu inceleyeceğim
https://docs.microsoft.com/tr-tr/do...g-guide/language-features/early-late-binding/

Örnek Dosyam burada

3 tane makrom var ekle bul güncelle. Hepsine call baglan yaptım
Siz çözümünüzü burada uygularsanız Mysql a uyarlarım ben

http://s7.dosya.tc/server5/2qeg7y/DENEME_ADO.rar.html

İyi günler

Murat OSMA · 7 Mayıs 2018

Gönderdiğiniz örnek dosyada tüm kodlar Sayfa1'in kod penceresinde görünüyordu..
Asıl dosyanız için verdiğim kodları da bu şekilde denediyseniz hatayı orada yapmışsınız demektir.

Öncelikle #10. mesajda verdiğim kodları, Insert menüsünden Module ekleyip oraya yapıştırarak tekrar deneyin.

Son gönderdiğiniz örnek dosyayı incelemeniz için çalışır hâlde düzenleyip linkini ekliyorum.
http://s7.dosya.tc/server5/h4lr0z/hlojan.rar.html

hlojan · 10 Mayıs 2018

Teşekkür Murat Bey;

attığınız dosya çalışıyordu. Onu Mysql çevirdim hata verdi.

Sonra kopyala yapıştır yapmadan tek tek yazınca oldu.
aşağıda paylaştım

Teşekkür ederim bilginize sağlık

Kod:

Public exk As Workbook, exs As Worksheet, exa As Worksheet, exh As Worksheet, bgln As Object, kyt As Object
Public site As String, database As String
Public kullanici As String, sifre As String, port As String
Public dtkod, dtfirma, dtadres As String

Public dtdosya As String




Sub tanimlama()

Set exk = ActiveWorkbook
Set exa = exk.Worksheets("Anasayfa")
Set exs = exk.Worksheets("Sertifika")
Set exh = exk.Worksheets("Hesaplama")
Set bgln = New ADODB.Connection
Set kyt = New ADODB.Recordset

site = "www.****.com.tr"
database = "*****t"
kullanici = "*****"
sifre = "****"
port = "***"

dtkod = exa.Range("hkod")
dtfirma = exa.Range("hfirma")
dtadres = exa.Range("hadres")
dtdosya = exa.Range("hdosya")



End Sub
Sub baglan()
bgln.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & site & _
                    ";Port=" & port & _
                    ";Database=" & database & _
                    ";User=" & kullanici & _
                    ";Password=" & sifre & _
                    ";Option=4;" & _
                    ";CharSet=latin5;"
End Sub

Sub firmaekle()
Call tanimlama
Call baglan

kyt.Open "select * from firma where kod='" & dtkod & "';", bgln, 1, 1


'*************** İŞLEM *******************
If kyt.EOF Then
kyt.Close
'****************SORGU*********************
kyt.Open "select * from firma;", bgln, 1, 3
'**************SORGU SON******************

kyt.AddNew
kyt("kod") = dtkod
kyt("sfirma") = dtfirma
kyt("sadres") = dtadres
kyt("dosya") = dtdosya
kyt.update
kyt.Close
MsgBox " Firma Eklendi"
Else

MsgBox " Firma Kayıtlıdır . Başka kod deneyiniz"
End If
'************** İŞLEM SON *****************

'****************BAĞLANTI KAPAT ***********
bgln.Close
Set kyt = Nothing: Set bgln = Nothing

End Sub

Murat OSMA · 11 Mayıs 2018

Konunun çözüme kavuşmasına sevindim.

İyi çalışmalar.

Ado Bağlantı Makrosu

hlojan

hlojan

Murat OSMA

Altın Üye

hlojan

hlojan

Murat OSMA

Altın Üye

Haluk

Özel Üye

Murat OSMA

Altın Üye

hlojan

Murat OSMA

Altın Üye

hlojan

Murat OSMA

Altın Üye

hlojan

Murat OSMA

Altın Üye