Excel Ado ile serverdaki dosyaya bağlanma ve güncelleme hk.

Katılım
27 Eylül 2013
Mesajlar
33
Excel Vers. ve Dili
2003 türkçe
Arkadaşlar Merhaba;
2 adet sorum olacak
1. Şirketimizde Ağ üzerinde bir adreste isprogramı_veri_tabanı.xlsx; dosyasını veri tabanı olarak kullanmaktayız. Tüm kullanıcılar kendi bilgisayarlarından windowsn 10 bir kere yerel ağ üzerinden bağlanıp servera bağlanmak istediklerinde kullanıcı adını ve şifresini girip hatırla seçeneği ile sonraki girişlerinde kullanıcı adı ve şifre girmeden direk bağlanıyorlar. Kendi bilgisayarlarına kaydettikleri makrolu excel dosyası ile Ağdaki dosyaya veri eklemek, veri güncellemek için bir dosya kullanmaktadırlar. Fakat bir kullanıcımız aşağıdaki satırda hata görüp veri ekleme, veri okumak vs yapamıyor. Ama yerel ağ üzerinden servera bağlanmasında hiç bir sorun yok. Tüm bilgisayarlarda office 2016 ev ve iş yüklü sorun ne olabilir.

Con.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=\\192.168.1.150\TeknikServis\GECİCİ DOSYA PAYLAŞIMI\VeriTabanı\isprogramı_veri_tabanı.xlsx;" & _
"Extended Properties=""Excel 8.0;HDR=Yes"""

2. Bazen dosya güncellemek, dosyaya veri eklemek için makroyu çalıştırdığımızda hiç bir hata vermemesine rağmen kayıtları güncellemiyor yada verileri eklemiyor. Ama ne garipki serverdaki isprogramı_veri_tabanı.xlsx; dosyasını açıp / kaydedip / kapatıp tekrar çalıştırdığımızda güncelleme de yapıyor. Kayıtta ekliyor. Neden böyle oluyor. Bu sorunu çözmek için ne yapabiliriz.


Sub Çoklu_Kayıtları_Guncelle()
personel = Range("A1")
Set liste = Sheets("Liste")
Dim Con As Object, rs As Object, Sorgu As String
Set Con = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
Con.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=\\192.168.1.150\TeknikServis\GECİCİ DOSYA PAYLAŞIMI\VeriTabanı\isprogramı_veri_tabanı.xlsx;" & _
"Extended Properties=""Excel 8.0;HDR=Yes"""

For x = 5 To Cells(Rows.Count, "C").End(3).Row
isno = Range("B" & x)
isemrino = Range("C" & x)
baslangic_tarihi = Range("I" & x)
bitis_tarihi = Range("J" & x)
If bitis_tarihi = "" Then
bitis_tarihi = "Null"
Else
bitis_tarihi = "'" & bitis_tarihi & "'"
End If

If baslangic_tarihi = "" Then
baslangic_tarihi = "Null"
Else
baslangic_tarihi = "'" & baslangic_tarihi & "'"
End If

isindurumu = Range("L" & x)
sorumlu = Range("M" & x)
aciklama = Range("n" & x)
kacgun = Range("o" & x)
gorevx = Range("H" & x)

For l = 3 To liste.Cells(Rows.Count, "B").End(3).Row
gorev = liste.Range("B" & l)
renk = liste.Range("B" & l).Font.Color
If gorevx = gorev Then
Sorgu = "update [Yapılacak iş Görevler$] set [Sorumlu]='" & sorumlu & "', [İşin Durumu]='" & isindurumu & "', [Başlangıç Tarihi]=" & baslangic_tarihi & ", [Bitiş Tarihi]=" & bitis_tarihi & ", [Açıklama]='" & aciklama & "', [Kaç Gün]='" & kacgun & "' WHERE [İşno]=" & isno & " and [İş Emri No]='" & isemrino & "' and [Yapılacak İş]=""" & gorevx & """"
Range("A3") = Sorgu
rs.Open Sorgu, Con, 1, 3

If renk <> 255 Then
Sorgu = "update [Veri Tabanı$] set [" & gorev & " Yapan Kişi]='" & sorumlu & "', [" & gorev & " Başlangıç Tarihi]=" & baslangic_tarihi & ", [" & gorev & " Bitiş Tarihi]=" & bitis_tarihi & " WHERE [İş Emri No]='" & isemrino & "'"
Range("A3") = Sorgu
rs.Open Sorgu, Con, 1, 3

End If

End If
Next l
Next x


Range("D4").Select

MsgBox "Kayıtlar Güncellendi"


End Sub
 
Katılım
27 Eylül 2013
Mesajlar
33
Excel Vers. ve Dili
2003 türkçe
Merhaba;
Bu konu hakkında uzman birisi yok mu. Desteğinizi rica ederim.
 
Üst