Zapis tablicy do pliku txt   strona główna:
A po co ten Excel ;-)
 
Dziś chciałbym pokazać sposob zapisu tablicy danych do pliku txt. Podstawowym sposobem jaki może nam przyjść do głowy  
przy realizacji tego zadania jest zapis pliku xls jako txt metodą SaveAs skoroszytu (FileFormat:=xlText) po co nam więc inne metody?   Workbook.SaveAs Method
Domyślnym separatorem kolumn w takiej metodzie jest TAB co nie zawsze może nam odpowiadać. Poza tym znając inne sposoby można  
zmienić prosty / bezwarunkowy zapis na taki jaki nam odpowiada. Nie zapisujemy całego Arkusza a zakres lub tablicę.  
 
Najprostszym sposobem będzie wykorzystanie metod VBA. Nie potrzeba wykorzystywać w tej procedurze metod zawartych w zewnęt-  
nych bibliotekach. Zainteresowanych, i chcących poszerzyć wiedze nt. tej metody polecam odwiedziny linków z prawej :-)   Sekwencyjne pliki danych
  File access functions in VBA
Sub TBL2TXT_VBA(vDane As Variant, _   Using binary file access
                strTXTFileFullName As String)  
    Dim nr As Integer  
    Dim tbl As Variant, iX As Long, iY As Integer  
    Dim strLine As String  
      
    Const strSep As String = ","  
      
    tbl = vDane  
    nr = VBA.FreeFile  
    Open strTXTFileFullName For Output As #nr  
        For iX = 1 To UBound(tbl, 1)  
            For iY = 1 To UBound(tbl, 2)  
                strLine = strLine & tbl(iX, iY) & strSep  
            Next  
            strLine = Left(strLine, Len(strLine) - Len(strSep))  
            Print #nr, strLine  
            strLine = vbNullString  
        Next  
    Close #nr  
End Sub  
 
 
Option Explicit  
 
Sub Start()  
    Dim strTXTFile As String  
    Dim xlWks As Excel.Worksheet, ostAD As Long  
      
    strTXTFile = ThisWorkbook.Path & "\temp.txt"  
      
    Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
    With xlWks  
        ostAD = Last(.Columns("A:D"))  
        If ostAD > 1 Then  
            '--------------sposób.1-------------  
            ' Jeżeli kolumny exportowane tworzą zakres ciągły..  
            TBL2TXT_VBA .Range("A1:D" & ostAD), strTXTFile  
              
            ' Jeżeli kolumny exportowane tworzą zakres nieciągły..  
            'TBL2TXT_VBA tblUnionZakresówH(.Range("A1:A" & ostAD), .Range("C1:C" & ostAD)), strTXTFile  
              
            MsgBox "Już :-)" & String(2, vbCrLf) & strTXTFile, vbInformation  
        End If  
    End With  
      
    Set xlWks = Nothing  
End Sub  
 
Function Last(rng As Excel.Range) As Long  
' wg. Ron de Bruin, 20 Feb 2007  
' http://www.rondebruin.nl/last.htm  
    On Error Resume Next  
    Last = rng.Find(What:="*", _  
                    After:=rng.Cells(1), _  
                    Lookat:=xlPart, _  
                    LookIn:=xlFormulas, _  
                    SearchOrder:=xlByRows, _  
                    SearchDirection:=xlPrevious, _  
                    MatchCase:=False).Row  
    On Error GoTo 0  
End Function  
 
Function tblUnionZakresówH(ParamArray Zakresy() As Variant) As Variant  
    Dim zakres As Variant  
    Dim wTbl As Long, kTbl As Integer  
    Dim tblWyniki() As Variant, k As Integer  
    Dim temptbl As Variant, iTbl As Long, jTbl As Integer  
      
    For Each zakres In Zakresy  
        With zakres  
            kTbl = kTbl + .Columns.Count  
            If wTbl < .Rows.Count Then wTbl = .Rows.Count  
        End With  
    Next  
    ReDim tblWyniki(1 To wTbl, 1 To kTbl)  
    For Each zakres In Zakresy  
        temptbl = zakres  
        For jTbl = 1 To UBound(temptbl, 2)  
            k = k + 1  
            For iTbl = 1 To UBound(temptbl, 1)  
                tblWyniki(iTbl, k) = temptbl(iTbl, jTbl)  
            Next  
        Next  
    Next  
    tblUnionZakresówH = tblWyniki  
End Function