Vakıfbank txt dosyası Oluşturma

[ozkovlu]

Merhabalar;
Ekli Excel dosyasında, Butona bastığımda dolu satırları txt formatına aktarmak istiyorum.
Gerekli açıklamalar ektedir.
Saygılarımla...
http://s4.dosya.tc/server4/d3bikq/vakifbank_disketi_olustur.zip.html

 

[işsiz123]

Deneyiniz

http://s5.dosya.tc/server4/0tokr4/vakifbank_disketi_olustur.rar.html

 

[Asri]

Alternatif;

Sadece TL ile ilgil bir sorun var.
Burası için 3 karakter belirtilmiş. EUR ve USD için sorun yok.
TL de iki katakter mi yazılacak, başına yada sonuna boşluk mu eklenecek belli değil. Ben sonuna bir boşluk ekledim.

http://dosya.co/fp3o9r7knnco/vakıfbank_disketi_oluştur.xlsm.html

Örnek:
184280015800728123456700000000000000012017050405000000000000000011.00MTR203654890015800728123456TL
184280015800728123456700000000000000022017050405000000000000001257.00MTR203654890015800728123456TL

Dim miktar, veri, personelhesap, personelsicil, subekodu, kurumkodu, odemetarihi, ay, odemeturu, doviz As String

Sub hazirla()
   verisatir = ""
   yol = ActiveWorkbook.Path & "\vakifmaas.txt"
   
   subekodu = Trim([C5])
   If Len(subekodu) > 3 Then
      MsgBox ("Şube kodu 3 karakterden uzun olamaz")
      Exit Sub
   End If
   subekodu = doldur(subekodu, 3)
   
   kurumkodu = Trim([C6])
   If Len(kurumkodu) > 2 Then
      MsgBox ("Kurum kodu 2 karakterden uzun olamaz")
      Exit Sub
   End If
   kurumkodu = doldur(kurumkodu, 2)
   
   odemetarihi = Trim(Format([C4], "yyyymmdd"))
   If Len(odemetarihi) <> 8 Then
      MsgBox ("Ödeme tarihi 8 olmalı")
      Exit Sub
   End If
   
   ay = Trim([C7])
   If Len(ay) > 2 Then
      MsgBox ("Ay 2 karakterden uzun olamaz")
      Exit Sub
   End If
   ay = doldur(ay, 2)
   
   odemeturu = Trim([C8])
   If Len(odemeturu) > 1 Then
      MsgBox ("Ödeme türü 1 karakterden uzun olamaz")
      Exit Sub
   End If
   
   doviz = Trim([D8])
   If Len(doviz) > 3 Then
      MsgBox ("Döviz 3 karakterden uzun olamaz")
      Exit Sub
   End If
   If doviz = "TL" Then doviz = "TL "
   
   '"subekodu/kurumkodu/personelhesap/personelsicil/odemetarihi/ay/miktar/odemeturu/iban/doviz/"
     Open yol For Output As #1
   sonsatir = Cells(Rows.Count, "B").End(3).Row
   For i = 11 To sonsatir
     personelhesap = Trim(Cells(i, "B").Value)
     If Len(personelhesap) > 17 Then
       MsgBox ("Personel hesap no 17 karakterden uzun olamaz")
       Exit Sub
     End If
     
     personelhesap = doldur(personelhesap, 17)
     personelsicil = Trim(Cells(i, "C").Value)
     If Len(personelsicil) > 16 Then
       MsgBox ("Personel sicil no 16 karakterden uzun olamaz")
       Exit Sub
     End If
     personelsicil = doldur(personelsicil, 16)
     
     miktar = Trim((Replace(Format(Cells(i, "D").Value, "0.00"), ",", ".")))
     If Len(miktar) > 21 Then
       MsgBox ("Meblağ 21 karakterden uzun olamaz")
       Exit Sub
     End If
     miktar = doldur(miktar, 21)
     
     iban = Trim(Cells(i, "E").Value)
     If Len(iban) > 26 Then
       MsgBox ("IBAN 26 karakterden uzun olamaz")
       Exit Sub
     End If
     
     veri = subekodu & kurumkodu & personelhesap & personelsicil & odemetarihi & ay & miktar & odemeturu & iban & doviz
     Print #1, veri
   Next i
   Close #1
   
End Sub

Function doldur(bilgi, uzunluk As Long) As String
   For i = 1 To uzunluk - Len(bilgi)
       bilgi = "0" & bilgi
   Next i
   doldur = bilgi
End Function

 

[ozkovlu]

Sayın işsiz123 ve asri;
Kodunuz 10 numara 5 yıldız.
Teşekkür ederim.

 

[işsiz123]

Rica Ederiz İyi Çalışmalar