inputbox ile veri alıp dosya yolu olarak kullanmak.

Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Selam arkadaşlar aşağıda yapmak istediğim inputbox ile stok programcımız tarafından c kök dizininde bulunan fatura dizininin içine fişnumaralarının isim olarak koyarak txt şeklinde atıyor. Benim yapmak istediğim ise inputbox ile bu fiş numarasını yazarak aşağıdaki kodların otomatik bir şekilde çalışmasını sağlamak.

hucre = ActiveCell.Address

deger = InputBox("Lütfen Fiş Numarasını Doğru bir Şekilde giriniz.")

With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\fatura\(deger)&.TXT", _
Destination:=Range(hucre))
.Name = "TESFAT"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 857
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 4, 15, 31)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\fatura\(deger)&.TXT", _

satırını

With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\fatura\" & deger & ".TXT", _

olarak değiştirin.
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Çok teşekkür ederim

Bir sorum daha olucak kullanınca çıkıyor hatalar. Diyelim ki bu deger değişkenine atadığımız değer 70130 olsun ve excel fatura dizininde 70130.txt dosyası arıyor ve bulursa çalışıyor bulamazsa hata veriyor. Bu hatayı önlemek için nasıl bir kontrol koyabilirim.
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Kodlarınızı aşağıdaki şekilde değiştiriniz.

Kod:
Sub TXTAktar()
hucre = ActiveCell.Address
deger = InputBox("Lütfen Fiş Numarasını Doğru bir Şekilde giriniz.", "UYARI", "70130")
kontrol = "C:\fatura\" & deger & ".TXT"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(kontrol) = False Then
MsgBox "Aradığınız Dosya Bulunmadı."
Exit Sub
Else
dosya = "TEXT;" & kontrol
With ActiveSheet.QueryTables.Add(Connection:=dosya, Destination:=Range(hucre))
.Name = "TESFAT"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 857
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 4, 15, 31)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
Set FSO = Nothing
End Sub
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Çok teşekkür ederim. Elinize sağlık çok işime yaradı.
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Sayın ripek bu işlemi ben Paylaştırılmış bir çalşıma kitabında kullanıcaktım Dış veri al iptal olduğu için kullanamadım. Acaba bu işlemi yani txt den veri alma işlemini dış veri al haricinde bir şekilde yapabilirmiyim.
 
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Çok özür diliyorum sizden benim yeteri kadar ingilizcem yok ve onu kendi çalışmama uyarlamaya çalıştım baktım ama anlayamadım. Yardımcı olursanız çok sevineceğim.
Benim için Çok önemli bir çalışma çünkü.
 
Üst