birden fazla kapalı çalışma kitabından veri almak

[muratcx]

Şifreleme yada sayfa koruma mevcut değil sayfada istedimiz değişikliği yapıyoruz ancak kaydedemiyoruz formatı değiştirmemiz gerekiyor

 

[Orion1]

Şifreleme yada sayfa koruma mevcut değil sayfada istedimiz değişikliği yapıyoruz ancak kaydedemiyoruz formatı değiştirmemiz gerekiyor

csv uzantılı dosya olmasın sakın.

 

[muratcx]

dosya üzerine sağ tıklayıp özeliklerine baktığımda (.XLS) yazıyor.
xlsx uzantılı dosyaya baktığımda parantez içinde olmadan .xlsx yazıyor

 

[Orion1]

dosya üzerine sağ tıklayıp özeliklerine baktığımda (.XLS) yazıyor.
xlsx uzantılı dosyaya baktığımda parantez içinde olmadan .xlsx yazıyor

Anladım.Maalesef bir fikrim yok.

 

[Orion1]

xls uzantılı dosyalar için ve sayfa ve dosya adını a1 hücresinden değilde sizin seçeceğiniz listeden bir dosyadan veriler alınacak.
Dosyanız ektedir.

Sub kapalidosyadanaktar59()
Dim conn As Object, rs As Object, yol As String, sayfa As String
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Range("A2:E" & Rows.Count).ClearContents
yol = ThisWorkbook.Path
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(filefilter:="Excel Dosyaları,*.xlsx;*.xls", _
Title:="Lütfen bir dosya seçininiz!")
If dosya = False Then Exit Sub
sayfa = Replace(Dir(dosya), ".xls", "")
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & _
    "\" & sayfa & ".xls;extended properties=""excel 12.0;hdr=no;imex=1"";"
rs.Open "select * from [" & sayfa & "$]", conn, 1, 1
Application.ScreenUpdating = False
Range("A2").CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Alındı" & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
End Sub

 

[muratcx]

Sayın Orion,
İlginize gerçekten çok teşekkür ederim son yazdığınız kodun benzeri hali hazırda kullandığım kodlar muhtemelen bu kodlarıda zamanında siz yazmış olmalısınız, çok benzer çünkü,
son vermiş olduğunuz kodlarda hata alıyorum, aşağıda ekte verilen örnek dosya şu anda kullandığım klasörden manuel seçerek çalışan kodlar mevcut
Bu kodlar revize edilip ilk ilk yazdığınız kodlara uyarlamak mümkün müdür?

Eğer bu şekilde olmuyorsa kapalı dosyalarım .text formatında olsa excele aktarmak mümkün olurmu( text olarak indirdiğimde problem yaşamıyorum silme kayıt vb gibi işleri yapabiliyorum).

 

[Orion1]

Bu dosyadan bir şey anlamadım.
siz txt olarak yollayın,öyle yapalım.ok.

 

[muratcx]

dosya ektedir

 

[Orion1]

dosya ektedir

Dosya ektedir.

Sub kapalidosyadanaktar59()
Dim yol As String, sat As Long
Range("A2:E" & Rows.Count).ClearContents
yol = ThisWorkbook.Path
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(filefilter:="Metin Dosyaları,*.txt", _
Title:="Lütfen bir dosya seçiniz.")
If dosya = False Then Exit Sub
sat = 2
Open (dosya) For Input As #1
    Do While Not EOF(1)
        Line Input #1, deg
        Cells(sat, "A").Value = deg
        sat = sat + 1
    Loop
Close #1
Application.ScreenUpdating = False
Application.ScreenUpdating = True
MsgBox "Veriler Alındı" & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
End Sub

 

[muratcx]

Sayın Orion
Şu anki kodlar başarılı bir şekilde text dosyasını excele aktarıyor,
Birde ilk mesajda ki gibi listeden seçmeden a1 hücresine girilen değere göre dosyayı bulup alsa harika olacak.
Yani veri sayfasını a1 hücresine dosya adını yazıp butonu tıkladığımda klasörden dosyayı bulu alması, biliyorum sizi çk yordum olsada olmasada emeğinize ayırmış olduğunuz zamana çok teşekkür ederim

 

[Orion1]

Sayın Orion
Şu anki kodlar başarılı bir şekilde text dosyasını excele aktarıyor,
Birde ilk mesajda ki gibi listeden seçmeden a1 hücresine girilen değere göre dosyayı bulup alsa harika olacak.
Yani veri sayfasını a1 hücresine dosya adını yazıp butonu tıkladığımda klasörden dosyayı bulu alması, biliyorum sizi çk yordum olsada olmasada emeğinize ayırmış olduğunuz zamana çok teşekkür ederim

Dosyanız ektedir.

Sub kapalidosyadanaktar59()
Dim dosya As String, sat As Long, deg
Range("A2:E" & Rows.Count).ClearContents
dosya = ThisWorkbook.Path & "\" & Range("A1").Value & ".txt"
If dosya = "" Then Exit Sub
sat = 2
Application.ScreenUpdating = False
Open (dosya) For Input As #1
    Do While Not EOF(1)
        Line Input #1, deg
        Cells(sat, "A").Value = deg
        sat = sat + 1
    Loop
Close #1
Application.ScreenUpdating = True
MsgBox "Veriler Alındı" & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
End Sub

 

[muratcx]

txt dosyasını excele manuel yöntemle yapıştırdığımda veriler kendi hücrelerine kopyalanıyor,Yukarıdaki kodlar gayet güzel çalışıyor anca hücreleri birleştirerek A sütununa kopyalıyor.

Çözümü varmıdır yoksa metin formatında olduğu için mi böyle oluyor.

 

[Orion1]

txt dosyasını excele manuel yöntemle yapıştırdığımda veriler kendi hücrelerine kopyalanıyor,Yukarıdaki kodlar gayet güzel çalışıyor anca hücreleri birleştirerek A sütununa kopyalıyor.

Çözümü varmıdır yoksa metin formatında olduğu için mi böyle oluyor.

Her satırda değişik aralıklarla veriler var.Bir standardı yok.Olsa idi yapılırdı.

 

[muratcx]

Sayın ORİON.

2. nolu mesajdaki kodu kullanabilme imkanı doğdu. Kapalı dosyanın verileri aldığımız sayfanın adı dosya adı ile aynı idi, Kapalı dosyaların sayfa adını Sheet1 olarak revize edebilirsek işimizi görecek.

İlginize çok teşekkür ederim.

 

[muratcx]

Merhaba arkadaşlar
2 nolu mesajdaki kodla kapalı olan dosyadan veri alıyorum
kapalı dosyalar ve verileri aldığım dosya aynı klasör içinde
Veri sayasında A1 hücresine yazdığım dosya adı aynı zamanda kapalı dosyanın adı
klasör içinde birden fazla kapalı dosyadan veri alıyorum.
kodlar gayet güzel çalışıyor. Ancak veri sayfasına a1 hücresine yazdığım dosya adı klasör içinde bulunan kapalı dosyalarla eşleşmiyorsa hata alıyorum.
msgbox uyarı ekleyerek arana dosya adı klasörde bulunmuyorsa, yada dosya tanınmıyorsa, "DOSYA BULUNAMADI " uarasını vermesi mümkün müdür?

 

[muratcx]

Sayın ORİON sizi burda görmek ne güzel
35 nolu mesajda yazdığım soruna çözüm bulamadım örnek uygulama bulamadım.
msgbox uyarısı yapmazsak dosya bulunmadığı yada yanlış olduğu zaman hata vermesinin önüne geçemiyoruz
Kapalı dosya klasör içinde bulunmuyorsa dosya bulunamadı uyarısı çıkması mümkün müdür?

 

[Orion1]

Dosyayı 2 nolu mesajdan indirebilirisiniz.2007 ve üstü versiyonlar içindir.