Ağdaki Dosya Yolu Yardım ?

[3641]

Aşağıdaki kod ile bilgisayarımdaki Veri.xls isimli dosyaya seçli verileri "Aktar" butonu ile gönderebiliyorum.

Ama dosyayı ağa koyduğumda sıkıntı yaşıyorum

Tam Dosya yolu : \\AYKAN-1\SharedDocs\katip\Aktar\Veri.xls)

Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Sub veri_yaz()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Byte
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & _
"\Veri.xls;Extended Properties=""Excel 12.0;HDR=yes"""
rs.Open "Select * from [Sayfa1$]", conn, 1, 3
baslik = InputBox("Başlık Giriniz", "BAŞLIK", "Başlık" & rs.RecordCount + 1)
If Not rs.EOF Then
rs.AddNew
rs(0).Value = baslik
rs(1).Value = Format(Date, "dd.mm.yyyy")
rs(2).Value = Cells(2, "A").Value
rs(3).Value = Cells(3, "A").Value
rs(4).Value = Cells(4, "A").Value
rs(5).Value = Cells(5, "A").Value
rs(6).Value = Cells(6, "A").Value
rs(7).Value = Cells(7, "A").Value
rs(8).Value = Cells(8, "A").Value
rs(9).Value = Cells(9, "A").Value
rs(10).Value = Cells(10, "A").Value
rs(11).Value = Cells(11, "A").Value
rs(12).Value = Cells(12, "A").Value
rs(13).Value = Cells(13, "A").Value
rs(14).Value = Cells(14, "A").Value
rs(15).Value = Cells(15, "A").Value
rs.Update
rs.Close
End If
MsgBox "Kayıt Başarı ile girildi."
End Sub

 

[asi_kral]

Merhaba

Sub veri_yaz()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Byte
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=\\AYKAN-1\SharedDocs\katip\Aktar\Veri.xls;Extended Properties=""Excel 12.0;HDR=yes"""
rs.Open "Select * from [Sayfa1$]", conn, 1, 3
baslik = InputBox("Başlık Giriniz", "BAŞLIK", "Başlık" & rs.RecordCount + 1)
If Not rs.EOF Then
rs.AddNew
rs(0).Value = baslik
rs(1).Value = Format(Date, "dd.mm.yyyy")
rs(2).Value = Cells(2, "A").Value
rs(3).Value = Cells(3, "A").Value
rs(4).Value = Cells(4, "A").Value
rs(5).Value = Cells(5, "A").Value
rs(6).Value = Cells(6, "A").Value
rs(7).Value = Cells(7, "A").Value
rs(8).Value = Cells(8, "A").Value
rs(9).Value = Cells(9, "A").Value
rs(10).Value = Cells(10, "A").Value
rs(11).Value = Cells(11, "A").Value
rs(12).Value = Cells(12, "A").Value
rs(13).Value = Cells(13, "A").Value
rs(14).Value = Cells(14, "A").Value
rs(15).Value = Cells(15, "A").Value
rs.Update
rs.Close
End If
MsgBox "Kayıt Başarı ile girildi."
End Sub

Bu şekilde dener misiniz.
Not : Deneme yapılmadı. Sadece yol eklemesi yapılmıştır.

 

[3641]

Sayın asi_kral_1967,
Elinize, emeğinize, klavyenize sağlık 2 gündür uğraşıyordum,
Yardımlarınız için ne kadar teşekkür etsem azdır,

Saygılarımla,

 

[asi_kral]

Sayın asi_kral_1967,
Elinize, emeğinize, klavyenize sağlık 2 gündür uğraşıyordum,
Yardımlarınız için ne kadar teşekkür etsem azdır,

Saygılarımla,

Kolay Gelsin.