《ExcelVBA_文本文件和文件夹操作实例集锦》由会员分享，可在线阅读，更多相关《ExcelVBA_文本文件和文件夹操作实例集锦（142页珍藏版）》请在金锄头文库上搜索。
1、.1，导入文本数据（QueryTables）110419.xlsSub daorwb() 2008-4-19 Columns(a:g).ClearContents文本文件名放在y2单元格，两文件在同一个文件夹 With ActiveSheet.QueryTables.Add(Connection:= _ TEXT; & ThisWorkbook.Path & & y2, Destination:=Range(A1) .FieldNames = True .PreserveFormatting = True .RefreshStyle = xlInsertDeleteCells .SaveDat
2、a = True .AdjustColumnWidth = False .TextFilePromptOnRefresh = False .TextFilePlatform = 936 .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileTabDelimiter = True .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1) .TextFileFixedCo
3、lumnWidths = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End WithEnd Sub 2，从文本文件中复制部分数据（OpenText方法）http:/ Macro1() 2007-10-18 （自编宏之四）从文本文件中复制部分数据Book1017.xls+test1017.txt Application.DisplayAlerts = False Dim Myflnm$ Myflnm = ThisWorkbook.Path & test1
4、017.txt Workbooks.OpenText Filename:=Myflnm, Origin _ :=xlWindows, StartRow:=37, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), TrailingMinusNum
5、bers:=True Selection.CurrentRegion.Copy ThisWorkbook.Activate a1.Select ActiveSheet.Paste Windows(test1017.txt).Activate ActiveWorkbook.Close Application.DisplayAlerts = TrueEnd Sub3，超链接自动生成（Hyperlink公式中引用单元格）Sub caolj1108()超链接1108.xls （自编宏之四）Dim Myr%, aa$, x%Myr = a65536.End(xlUp).RowFor x = 4 To M
6、yr - 3 aa = Cells(x, 1) If aa And InStr(aa, 小) = 0 And InStr(aa, 月) = 0 Then Cells(x, n).Formula = =if(-(right(rc-13,2) 0 Then n = .FoundFiles.Count MsgBox 该文件夹里有 & n & 个jpg文件 ReDim myfile(1 To n) As String For i = 1 To n myfile(i) = .FoundFiles(i) Cells(i, 1) = myfile(i) Next Else MsgBox 该文件夹里没有任何文
7、件 End If End With Set myFs = Nothing Call Macro1End SubSub Macro1() Dim Myr%, x%, aa$ Myr = a65536.End(xlUp).Row For x = 1 To Myr aa = Cells(x, 1) Cells(x, 2).Select ActiveSheet.Pictures.Insert (aa) Next xEnd Sub5，查询指定文件夹图片（Pictures.Insert 函数）Book1113.xls （自编宏之四）Private Sub Worksheet_SelectionChange
8、(ByVal Target As Range) Dim Myr%, x%, aa$ Dim myPath As String Myr = a65536.End(xlUp).Row If Target.Address $D$1 Then Exit Sub myPath = F:论坛数据Excel论坛未完成相片 你的图片文件夹 aa = myPath & d2 & .jpg Cells(2, 6).Select ActiveSheet.Pictures.Insert (aa)End Sub6，导出N列数据到文本文件http:/ （自编宏之四）Sub 导出N列数据()Dim Filename As
9、StringDim rows As Long, cols As IntegerDim i As Long, j As IntegerDim Data As VariantDim cell As RangeDim Arr, T, x%, fname$, fdir, N%fdir = ThisWorkbook.Path & 号码N = 7Filename = fdir & & (N - 6) & .txtRange(g5:g1004).Copy am5Range(o5:o1004).Copy an5Range(t5:t1004).Copy ao5Range(z5:z1004).Copy ap5Range(am5:ap1004).SelectSet cell = Selectioncols = cell.Columns.Countrows = cell.rows.CountOpen Filename For Output As #1For i = 1 To rows For j = 1 To cols Data = cell.Cells(i, j).Value If IsEmpty(cell.Cells(i, j) Then Data = If j cols Then Write #1, Data; Else Write #1, Data End If Next jNe
