Excel VBA - 文本文件和文件夹操作实例集锦(6)

If rr > Myr Then Data = \ If rr <> i + 4 Then

Data = Arr(rr, 1) & vbTab & Arr(rr, 2) & vbTab & Arr(rr, 3) n = n + Arr(rr, 3) Else

Data = \ End If

Print #1, (Data) Next Close #1 Next

Application.ScreenUpdating = True End Sub

13，导入文本文件（用文本文件名为新表命名）

Sub Drwbwj()

' 导入文本文件,用文本文件名为新表命名 ‘导入文本文件.xls （自编宏之一） ' by:蓝桥玄霜 ' 2007-3-7

‘http://www.excelpx.com/dispbbs.asp?boardid=5&id=13592 Dim Mystr As String

Dim filename '文件路径 '选取文件

Application.ScreenUpdating = False On Error GoTo 100 Do

filename = Application.GetOpenFilename(\Files (*.txt), *.txt\, \请选择文件\, MultiSelect:=False)

ActiveWorkbook.Worksheets.Add '把文本文件导入Excel新表

With ActiveSheet.QueryTables.Add(Connection:= _ \ .Refresh BackgroundQuery:=False End With

[j2] = filename '以下为获取文件名，给新表命名 [j3].Select

ActiveCell.FormulaR1C1 = _

\(SUBSTITUTE(R[-1]C,\ [j4].Select

ActiveCell.FormulaR1C1 = \ Mystr = [j4] 'MsgBox Mystr

ActiveSheet.Name = Mystr

Range(\ '删除辅助列 Loop Until filename = False GoTo 200 100:

Application.DisplayAlerts = False ‘不使报警 ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True 200:

Application.ScreenUpdating = True End Sub

Sub LxDrwbwj() ' 连续导入文本文件 ‘导入后.xls ' by:蓝桥玄霜 ' 2007-3-19

Dim filename ‘文件路径 Dim Myr1%, n%

Application.ScreenUpdating = False On Error GoTo 200

ActiveWorkbook.Worksheets(\ '激活表1 n = 1 Do

filename = Application.GetOpenFilename(\Files (*.txt), *.txt\, \请选取文件\, MultiSelect:=False) ‘选取文本文件

With ActiveSheet.QueryTables.Add(Connection:= _

\ .Refresh BackgroundQuery:=False If n > 1 Then

Range(\ ‘第二个表头行删除 End If

Myr1 = [a1].End(xlDown).Row n = Myr1 + 1 End With

Loop Until filename = False 200:

Application.ScreenUpdating = True End Sub

14，导出到文本文件

‘2007314

‘体彩3D分析.xls （自编宏之一） ‘先选择要导出的数据

Private Sub CommandButton1_Click() Dim Filename As String

Dim rows As Long, cols As Integer Dim i As Long, j As Integer Dim Data As String Dim cell As Range

Set cell = Selection ‘选择数据 cols = cell.Columns.Count rows = cell.rows.Count

Filename = \论坛\\精英培训\\数据0313.txt\Open Filename For Output As #1 For i = 1 To rows

Data = cell.Cells(i, cols) ‘一列数据

If IsEmpty(cell.Cells(i, cols)) Then Data = \ Print #1, (Data) ‘字符串型可去除”” ‘如果用Write #1 Data，输出的是”200365” Next i Close #1

End Sub

15，导出指定区域数据到文本文件，路径可选择（GetSaveAsFilename）

‘http://club.excelhome.net/dispbbs.asp?boardID=2&ID=316431&page=1&px=0 Private Sub CommandButton1_Click() Dim Filename As String

Dim rows As Long, cols As Integer Dim i As Long, j% Dim Data As String Dim cell As Range

Set cell = Selection '选择数据 cols = cell.Columns.Count rows = cell.rows.Count

‘Filename = Application.GetSaveAsFilename(\

Do

Filename = Application.GetSaveAsFilename Loop Until Filename <> False

Open Filename For Output As #1 For i = 1 To rows For j = 1 To cols

Data = cell.Cells(i, j) & \

If j = cols Then Print #1, (Data): GoTo 100 Print #1, (Data); Next j 100: Next i Close #1 End Sub

16，导入指定文件夹的文本文件（包括子文件夹），用文本文件名为新表命名，FileSearch，分列

Sub pldrwb0423() ‘inandout.xls EP

'批量导入指定文件夹文本文件 Dim myFs As FileSearch

Dim myPath As String, Filename$ Dim i As Long, n As Long