VBA/Excel/Access/Word/Excel/Excel to Text File

Материал из VB Эксперт
Перейти к: навигация, поиск

Exporting a range to a text file

   <source lang="vb">

Sub ExportRange()

   FirstCol = 1
   LastCol = 3
   FirstRow = 1
   LastRow = 3
   
   Open ThisWorkbook.Path & "\textfile.txt" For Output As #1
       For r = FirstRow To LastRow
           For c = FirstCol To LastCol
               Dim vData As Variant
               vData = Cells(r, c).value
               If IsNumeric(vData) Then vData = Val(vData)
               If c <> LastCol Then
                   Write #1, vData;
               Else
                   Write #1, vData
               End If
           Next c
       Next r
   Close #1

End Sub

</source>
   
  


Importing a text file to a range

   <source lang="vb">

Sub ImportRange2()

   Set ImpRng = ActiveCell
   Open ThisWorkbook.Path & "\textfile.txt" For Input As #1
   txt = ""
   Application.ScreenUpdating = False
   Do While Not EOF(1)
       Line Input #1, vData
       For i = 1 To Len(vData)
           char = Mid(vData, i, 1)
           If char = "," Or i = Len(vData) Then
               Debug.Print txt
           Else
               If char <> Chr(34) Then _
                 txt = txt & Mid(vData, i, 1)
           End If
       Next i
   Loop
   Close #1
   Application.ScreenUpdating = True

End Sub

</source>
   
  


TextToColumns Example

   <source lang="vb">

Sub TestTextToColumns()

   Dim rg As Range 
   Set rg = ThisWorkbook.Worksheets("Text to Columns").Range("a20").CurrentRegion 
   CSVTextToColumns rg, rg.Offset(15, 0) 
   CSVTextToColumns rg 
   Set rg = Nothing 

End Sub Sub CSVTextToColumns(rg As Range, Optional rgDestination As Range)

   If IsMissing(rgDestination) Or rgDestination Is Nothing Then 
       rg.TextToColumns , xlDelimited, , , , , True 
   Else 
       rg.TextToColumns rgDestination, xlDelimited, , , , , True 
   End If 

End Sub

</source>