Excel VBA_文本文件和文件夹操作实例集锦

1，导入文本数据（QueryTables）‘110419.xlsSubdaorwb()'2008-4-19Columns(a:g).ClearContents‘文本文件名放在[y2]单元格，两文件在同一个文件夹WithActiveSheet.QueryTables.Add(Connection:=_TEXT;&ThisWorkbook.Path&\&[y2],Destination:=Range(A1)).FieldNames=True.PreserveFormatting=True.RefreshStyle=xlInsertDeleteCells.SaveData=True.AdjustColumnWidth=False.TextFilePromptOnRefresh=False.TextFilePlatform=936.TextFileStartRow=1.TextFileParseType=xlFixedWidth.TextFileTextQualifier=xlTextQualifierDoubleQuote.TextFileTabDelimiter=True.TextFileColumnDataTypes=Array(2,1,1,1,1,1,1).TextFileFixedColumnWidths=Array(1,1,1,1,1,1).TextFileTrailingMinusNumbers=True.RefreshBackgroundQuery:=FalseEndWithEndSub2，从文本文件中复制部分数据（OpenText方法）‘=92&ID=28958&replyID=&skin=1SubMacro1()'2007-10-18（自编宏之四）'从文本文件中复制部分数据‘Book1017.xls+test1017.txtApplication.DisplayAlerts=FalseDimMyflnm$Myflnm=ThisWorkbook.Path&\test1017.txtWorkbooks.OpenTextFilename:=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)),TrailingMinusNumbers:=TrueSelection.CurrentRegion.CopyThisWorkbook.Activate[a1].SelectActiveSheet.PasteWindows(test1017.txt).ActivateActiveWorkbook.CloseApplication.DisplayAlerts=TrueEndSub3，超链接自动生成（Hyperlink公式中引用单元格）Subcaolj1108()‘超链接1108.xls（自编宏之四）DimMyr%,aa$,x%Myr=[a65536].End(xlUp).RowForx=4ToMyr-3aa=Cells(x,1)IfaaAndInStr(aa,小)=0AndInStr(aa,月)=0ThenCells(x,n).Formula==if(--(right(rc[-13],2))=50,mid(rc[-13],2,2)&01-&mid(rc[-13],2,2)&50,mid(rc[-13],2,2)&51-&text(mid(rc[-13],3,1)+1,00)&00)‘辅助列公式Cells(x,o).Formula==HYPERLINK(\\Tfknit\texford\生產通知單類\2007生產通知單\&rc[-1]&\&RIGHT(rc[-14],4)&\&rc[-14]&生產進度明細表.xls,進度明細表)Cells(x,p).Formula==HYPERLINK(\\Tfknit\texford\生產通知單類\2007生產通知單\&rc[-2]&\&RIGHT(rc[-15],4)&\&rc[-15]&生產通知單.xls,rc[-15])Cells(x,q).Formula==HYPERLINK(\\Tfknit\texford\生產通知單類\2007生產通知單\&rc[-3]&\&RIGHT(rc[-16],4)&\&rc[-16]&PO.pdf)EndIfNextxEndSub4，批量插入指定文件夹图片（FileSearch函数）Subplcrtp1111()（自编宏之四）'批量插入指定文件夹图片DimmyFsAsFileSearchDimmyPathAsStringDimiAsLong,nAsLongSetmyFs=Application.FileSearchmyPath=C:\MyDocuments\MyPictures\'你的图片文件夹WithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypePhotoDrawFiles.Filename=*.jpgIf.Execute(SortBy:=msoSortByFileName)0Thenn=.FoundFiles.CountMsgBox该文件夹里有&n&个jpg文件ReDimmyfile(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)Cells(i,1)=myfile(i)NextElseMsgBox该文件夹里没有任何文件EndIfEndWithSetmyFs=NothingCallMacro1EndSubSubMacro1()'DimMyr%,x%,aa$Myr=[a65536].End(xlUp).RowForx=1ToMyraa=Cells(x,1)Cells(x,2).SelectActiveSheet.Pictures.Insert(aa)NextxEndSub5，查询指定文件夹图片（Pictures.Insert函数）Book1113.xls（自编宏之四）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)DimMyr%,x%,aa$DimmyPathAsStringMyr=[a65536].End(xlUp).RowIfTarget.Address$D$1ThenExitSubmyPath=F:\论坛数据\Excel论坛\未完成\相片\'你的图片文件夹aa=myPath&[d2]&.jpgCells(2,6).SelectActiveSheet.Pictures.Insert(aa)EndSub6，导出N列数据到文本文件=2&ID=280260&replyID=&skin=0‘求修改代码.xls（自编宏之四）Sub导出N列数据()DimFilenameAsStringDimrowsAsLong,colsAsIntegerDimiAsLong,jAsIntegerDimDataAsVariantDimcellAsRangeDimArr,T,x%,fname$,fdir,N%fdir=ThisWorkbook.Path&\号码N=7Filename=fdir&\&(N-6)&.txtRange(g5:g1004).Copy[am5]Range(o5:o1004).Copy[an5]Range(t5:t1004).Copy[ao5]Range(z5:z1004).Copy[ap5]Range(am5:ap1004).SelectSetcell=Selectioncols=cell.Columns.Countrows=cell.rows.CountOpenFilenameForOutputAs#1Fori=1TorowsForj=1TocolsData=cell.Cells(i,j).ValueIfIsEmpty(cell.Cells(i,j))ThenData=IfjcolsThenWrite#1,Data;ElseWrite#1,DataEndIfNextjNextiClose#1Range(am5:ap1004).ClearContentsEndSub7，同文件夹根据文本数据修改（Opentext，分列，Name）‘Mybk1.xls(QQ)（自编宏之五）Sub批量修改文件名()'同文件夹根据文本文件数据修改'08-02-16DimOldNameAsString,NewNameAsStringDimMyflnm$DimMyr%,x%,Arr,aa$,bb$OnErrorResumeNextApplication.DisplayAlerts=FalseMyflnm=ThisWorkbook.Path&\目录.txtWorkbooks.OpenTextFilename:=Myflnm,Origin_:=xlWindows,StartRow:=2,DataType:=xlDelimited,TextQualifier:=_xlDoubleQuote,ConsecutiveDelimiter:=False,Tab:=True,Semicolon:=False,_Comma:=False,Space:=False,Other:=False,FieldInfo:=Array(Array(1,1),_Array(2,1)),TrailingMinusNumbers:=TrueColumns(A:A).SelectSelection.TextToColumnsDestination:=Range(A1),DataType:=xlFixedWidth,_FieldInfo:=Array(Array(0,1),Array(3,1)),TrailingMinusNumbers:=TrueSelection.CurrentRegion.CopyThisWorkbook.Activate[a1].SelectActiveSheet.PasteWindows(目录.txt).ActivateActiveWorkbook.CloseMyr=[a65536].End(xlUp).RowArr=Range(a1:b&Myr)Forx=1ToMyraa=Format(Arr(x,1),000)bb=Trim(Arr(x,2))OldName=ThisWorkbook.Path&\&aa&.swf'原文件名NewName=ThisWorkbook.Path&\&bb&.swf'新文件名NameOldNameAsNewName'在同一个文件夹更改文件名NextxApplication.DisplayAlerts=TrueEndSub8，有条件导出文本文件到桌面（Output、Print、Environ）‘aa.xls（自编宏之五）Subdaocuwb0408()DimrngAsRange,celAsRange,Filename$Dimaa$,col%,i%Setrng=Range(f1:ik1)ForEachcelInrngIfcelThenIfLen(cel)0Thenaa=Split(cel.Address,$)(1)‘取得列的字符col=cel.ColumnFilename=Environ(USERPROFILE)&\桌面\&aa&.txtOpenFilenameForOutputAs#1Fori=26To245Data=Cel