Ağdaki Kapalı Excel Dosyasına Kayıt

[kanakan52]

Üstatlar yardım lütfen...

"\\GURSOY-SRV\gursoy\" yolundaki "DATA.xlsx" dosyası kapalı olmak üzere;

Başka bir excel dosyasında oluşturduğum UserForm2' deki
TextBox1 = DATA.xlsx dosyasında "A" sütununa,
TextBox2 = DATA.xlsx dosyasında "B" sütununa,
TextBox3 = DATA.xlsx dosyasında "C" sütununa,
TextBox4 = DATA.xlsx dosyasında "D" sütununa,
en son dolu satırdan sonra kayıt yapacak şekilde koda ihtiyacım var. Yardımlarınızı rica ediyorum. Şimdiden teşekkür ederim.

 

[TEGCreative]

Merhaba ; dener misiniz lütfen ? Deneme şansım yok ağ olmadığından dolayı.
Userform kaydet butonuna

Private Sub KaydetButonu()
Dim Dosya_Yolu
Dosya_Yolu = ("\\GURSOY-SRV\gursoy\DATA.xlsx")
Dosya_Yolu = Shell("C:\WINDOWS\Explorer.exe " & Dosya_Yolu, vbNormalFocus)
ActiveWorkbook.Sheets("SeçmekİstediğinizSayfaİsmi").Select
Satır = .Range("A65536").End(3).Row +1
.Cells(Satır, 1) = TextBox1
.Cells(Satır, 2) = TextBox2 
.Cells(Satır, 3) = TextBox3
.Cells(Satır, 4) = TextBox4
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[Ömer BARAN]

Merhaba.

Sanırım Satır = .Range("A65536").End(3).Row +1 olması lazım.
.

 

[TEGCreative]

Uyarınız için sağolun Ömer hocam ; devamlı aynı satır yazdırıp arkadaş'a kafa yedirtecektik

 

[kanakan52]

Merhabalar, öncelikle ilginiz için ikinize de teşekkür ediyorum. " Zaten kafayı yemiş durumdayım.. Çok bir şey değişmezdi

Konuya dönecek olursak tam da bahsettiğiniz satırda "Satır = .Range("A65536").End(3).Row +1" de ".Range" kısmında hata gösterip "Compile Error-İnvalid or unqualified reference" uyarısı verdi...

 

[halit3]

Birde bu kodu dene

kırmızı yerlere kendi klasör, dosya adı ve sayfa adını yazınız.

Sub aktar_dosya()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
klasör_adı = [COLOR="red"]"\\GURSOY-SRV\gursoy\"[/COLOR]
dosya_adı = [COLOR="red"]"Data.xlsx"[/COLOR]
sayfa_Adı = [COLOR="red"]"Sayfa1"[/COLOR]
Set wb = Workbooks.Open(klasör_adı & dosya_adı)
Set dosya = Workbooks(dosya_adı).Sheets(sayfa_Adı)
sat = dosya.Cells(Rows.Count, "a").End(3).Row + 1
dosya.Cells(sat, "a") = TextBox1.Text
dosya.Cells(sat, "b") = TextBox2.Text
dosya.Cells(sat, "c") = TextBox3.Text
dosya.Cells(sat, "d") = TextBox4.Text
wb.Save
wb.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "işlem tamam"
End Sub

 

[kanakan52]

Halit Bey kodlarınız mükemmel çalışıyor. 5 dk önce halletmiştim aslında... Ama hem merak ettiğimden hem de alternatif olsun diye denedim kodlarınızı tam oldu. Allah razı olsun.

Bu arada benim kullandığım kodları da paylayaşım bir arkadaşımın ihtiyacı görülür belki...

Private Sub CommandButton1_Click()
Set Con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
Yol = "\\GURSOY-SRV\gursoy\"
Con.Open "provider=microsoft.ACE.oledb.12.0;data source=" & Yol & "DATA.xlsx" & _
";extended properties=""Excel 8.0;hdr=yes"""
Sorgu = "select * from [Sayfa1$] where [Cari İsmi]='" & TextBox1.Text & "'"
rs.Open Sorgu, Con, 1, 3
If rs.RecordCount = 0 Then
rs.AddNew
rs(0).Value = TextBox1.Value
rs(1).Value = TextBox2.Text
rs(2).Value = TextBox3.Text
rs(3).Value = TextBox4.Text
'rs(4).Value = TextBox5.Text
rs.Update
End If
MsgBox "Kayıt işlemi tamamlanmıştır."
rs.Close: Con.Close
Set Con = Nothing: Set rs = Nothing
End Sub

 

[aytekin44]

Merhaba,

Kodlar benimde işime yaradı ancak ağın geç yanıt vermesi sonucu kayıt işleminde sorun yaşıyorum, 10 sn bekle sonra işlem yap gibi bir şey yapabilir miyiz?

Desteğinizi rica ederim.