Ⅰ 如何利用VBA获取文件夹里边word文件个数
下面的代码在我电脑上执行通过，希望对比编程有所借鉴：
OptionExplicitSubYgB()Dimn,fn=0f=Dir("d:我的文档exp*.doc*")Whilef<>""n=n+1f=DirWendMsgBox"总共有"&n&"个WORD文件"EndSub
Ⅱ excel vba 中如何取得目录下文件的数量
FunctionFileCount(cPathAsString)asIntegercFile=Dir(cPath&"*.*")DoWhilecFile<>""FileCount=FileCount+1cFile=DirLoopEndFunction
这是一段自定义函抄数，袭在Excel VBA编辑模式下，主菜单“插入”——“模块”，将代码粘贴到右侧编辑区。如果在工作表状态下使用，在单元格输入：=FileCount("c:XXX")就可以得出c:XXX文件夹下的所有文件个数（不含子文件夹)；如果在代码中使用，则可以：nFileCount=FileCount("c:XXX")得到文件个数。注意：cPath参数必须以“”符号结尾。
Ⅲ excel表格用vba查询指定文件夹里子文件夹数量
需要沟通才能理解你的意图
Ⅳ 如何利用excel vba自动列出指定文件夹目录下的所有文件
下面的抄例子代码显示C:所有文件，供你参考：
OptionExplicitSubygb()Dimf,ii=1f=Dir("c:")Whilef<>""Cells(i,"A")=fi=i+1f=DirWendEndSub
Ⅳ vba中要获取文件夹里excel文件的数量，要用什么语句
1.GetAttr 函数语法：GetAttr(pathname)功能：获取一个文件、目录、或文件夹的属性。返回一个 Integer值。返回值由 GetAttr 返回的值，是下面这些属性值的总和：常数 值 描述 vbNormal 0 常规 vbReadOnly 1 只读 vbHidden 2 隐藏 vbSystem 4 系统文件vbDirectory 16 目录或文件夹 vbArchive 32 存档文件 vbalias 64 指定的文件名是别名。只在Macintosh中可用。 说明：若要判断是否设置了某个属性，在 GetAttr 函数与想要得知的属性值之间使用 And 运算符与逐位比较。如果所得的结果不为零，则表示设置了这个属性值。示例：Debug.Print GetAttr("F:\test.txt") '若为存档文件，在立即窗口可看到值为32Debug.Print GetAttr("F:\test.txt") '将属性—高级—可存档文件的勾去掉后，值为0为判断一个文件是否只读，可用下法:Debug.Print GetAttr("F:\test.txt") And vbReadOnly若值非零，说明时只读的。2.复制'' （1）. 在不需要逐个打开工作簿的情况下,将其有效工作表依次复制到本工作簿的最后.' 新工作表名为:原工作簿名_原工作表名'' Sub 复制工作表() Dim MyObject As Object Dim strPath As String, strFileName As String, strMyName As String Dim shtSheet As Worksheet, strShtName As String Dim intCount As Integer, intShtCount As Integer, i As Integer Application.ScreenUpdating = False strPath = ThisWorkbook.Path strMyName = ThisWorkbook.Name intShtCount = ThisWorkbook.Sheets.Count With Application.FileSearch .NewSearch .LookIn = strPath .SearchSubFolders = False .Filename = ".xls" .FileType = msoFileTypeOfficeFiles If .Execute() > 0 Then intCount = .FoundFiles.Count For i = 1 To intCount strFileName = Replace(.FoundFiles(i), strPath & "\", "") If strFileName <> strMyName Then Set MyObject = GetObject(strPath & "/" & strFileName) '下面进行复制工作 For Each shtSheet In MyObject.Worksheets strShtName = shtSheet.Name If MyObject.Sheets(strShtName).UsedRange.Count > 1 Then MyObject.Sheets(strShtName).Copy After:=ThisWorkbook.Sheets(intShtCount) intShtCount = intShtCount + 1 '重新命名 strShtName = Replace(strFileName, ".xls", "_") & strShtName ThisWorkbook.Sheets(intShtCount).Name = strShtName ThisWorkbook.Sheets("目录").Cells(i + 1, 1) = strShtName End If Next shtSheet End If Next i Else MsgBox "没有找到符合指定文件，请修改参数后重新搜索！", ,"提示" End If End With ThisWorkbook.Sheets("目录").Select Application.ScreenUpdating = TrueEnd Sub''（2） 逐个打开同一目录下的所有工作簿,将其有效工作表依次复制到本工作簿的最后.复制完后关闭它.' 新工作表名为:原工作簿名_原工作表名'Sub 复制工作表_2() Dim MyObject As Object Dim strPath As String, strFileName As String, strMyName As String Dim shtSheet As Worksheet, strShtName As String Dim intCount As Integer, intShtCount As Integer, i As Integer Application.ScreenUpdating = False strPath = ThisWorkbook.Path strMyName = ThisWorkbook.Name intShtCount = ThisWorkbook.Sheets.Count With Application.FileSearch .NewSearch .LookIn = strPath .SearchSubFolders = False .Filename = ".xls" .FileType = msoFileTypeOfficeFiles If .Execute() > 0 Then intCount = .FoundFiles.Count For i = 1 To intCount strFileName = Replace(.FoundFiles(i), strPath & "\", "") If strFileName <> strMyName Then 'Workbooks.Open Filename:=strPath & "/" & strFileName Set MyObject = GetObject(strPath & "/" & strFileName) '下面进行复制工作 For Each shtSheet In Workbooks(strFileName).Worksheets strShtName = shtSheet.Name If Workbooks(strFileName).Sheets(strShtName).UsedRange.Count > 1 Then Workbooks(strFileName).Sheets(strShtName).Copy After:=ThisWorkbook.Sheets(intShtCount) intShtCount = intShtCount + 1 '重新命名 strShtName = Replace(strFileName, ".xls", "_") & strShtName ThisWorkbook.Sheets(intShtCount).Name = strShtName ThisWorkbook.Sheets("目录").Cells(i + 1, 1) = strShtName End If Next shtSheet 'Workbooks(strFileName).Close End If Next i Else MsgBox "没有找到符合指定文件，请修改参数后重新搜索！", ,"提示" End If End With ThisWorkbook.Sheets("目录").Select Application.ScreenUpdating = TrueEnd Sub
Ⅵ excel怎样用VBA的方式实现文档所在文件夹下的文件内容汇总
戳我头像，一切都会有的。 所得取决于所付出的。
大家都很忙的，别说帮忙，越帮越忙。
上文件，最好上两个部门的，和结果。
Sub同文件夹下所有文件()SetR=CreateObject("Scripting.FileSystemObject").GetFolder("X:我的照片Camera")'可以改成你的路径ForEachFInR.FilesDebug.PrintF.Name'这里放你的宏，f.name就是依次的文件名NextEndSubSub同文件夹下所有文件汇总()DimwjjAsStringDimDirNameAsStringDimname1AsStringIfActiveWorkbook.Path="X:excel"ThenExitSub'自我保护。Application.ScreenUpdating=FalseForj=1To3'根据表数Worksheets(j).Cells.ClearNextjwjj=ActiveWorkbook.Pathname1=ActiveWorkbook.NameDirName=Dir(wjj&"*.xls")DoWhileDirName<>""IfDirName<>name1ThenWorkbooks.OpenFilename:=wjj&""&DirNameWorkbooks(name1).ActivateFori=1To3'根据表数Sheets(i).Range("a65536").End(xlUp).Offset(1,0).Offset(0,1)=DirNameWorkbooks(DirName).Sheets(i).Range("A4:J2000").Copy_Sheets(i).Range("a65536").End(xlUp).Offset(2,0)NextWorkbooks(DirName).CloseFalseEndIfDirName=DirLoopApplication.ScreenUpdating=TrueEndSub
仅供参考。
Ⅶ 在VBA中写一个过程,显示该目录下有多少个excel文件,并将该目录下excel文件名写到该目录下list.txt文件中.
'新建一个工作薄'运行下面的宏Sub mulu() On Error Resume Next Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.Show s = fd.SelectedItems(1) Set f = fs.GetFolder(s) Set fc = f.Files Open s & "\list.txt" For Output As #1 For Each f1 In fc If Right(f1.Name, 3) <> "xls" Then GoTo nt Write #1, f1.Name n = n + 1nt: Next Close #1 MsgBox nEnd Sub
Ⅷ excel vba 如何列举相同目录下的所有文件
Set fso = CreateObject("Scripting.FileSystemObject") set objFolder=fso.GetFolder(path)set objFiles=objFolder.Filesfor each objFile in objFiles if right( objFile.name,4)=".xls" then '保存在数组 end ifnext
Ⅸ VBA汇总统一文件夹下的多个表格的数据
大家好，今天继续讲解《VBA数据库解决方案》，今日讲解的是第37讲，利用ADO，实现同一文件夹下多个EXCEL工作表的数据汇总。最近的内容实用性比较强，如今日的内容，只把需要汇总的EXCEL文件放在同一个文件夹下，而且格式一致，那么利用ADO汇总这几个文件的数据是非常快的,这讲的内容和第32讲的内容是类似的，不过第32讲的内容是要事先知道文件的名称，然后建立一个数组来分别对应每个文件，通过循环来实现从每个文件中提取数据的目的，本讲的内容是事先不知道每个文件的名称。实例：在一个文件夹下有若干个文件，如下图：我们现在，需要把上面的文件夹中除了“VBA与数据库操作”之外的各个文件的内容一次性汇总出来，这个VBA程序该如何写呢？代码如下：Sub mynzexcels_6()'第37讲，利用ADO,实现同一文件夹下EXCEL工作表数据的汇总Dim cnADO As ObjectDim strPath, strTable, strSQL, Z As StringSet cnADO = CreateObject("ADODB.Connection")Range("a:g").ClearContentsRange("a1:e1") = Array("日期", "型号", "批号", "出库数量", "库存数量")Z = Dir(ThisWorkbook.Path & "\*.*")strPath = ThisWorkbook.Path & "\" & ZstrTable = "[sheet1$A2:h65536]"'建立连接,提取数据x = 2Do While Z <> ""If Z <> "VBA与数据库操作.xlsm" ThencnADO.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 8.0;hdr=no;imex=1';data source=" & strPathstrSQL = "select F1,F2,F3,F4,F5 from " & strTableRange("A" & x).CopyFromRecordset cnADO.Execute(strSQL)x = Range("b65536").End(xlUp).RowcnADO.CloseEnd IfZ = DirLoopSet cnADO = NothingEnd Sub代码截图：代码讲解：1 Z = Dir(ThisWorkbook.Path & "\*.*") 其中DIR函数用来指定文件名的字符串表达式，可能包含目录或文件夹、以及驱动器。如果没有找到 pathname，则会返回零长度字符串 ("")。2 strPath = ThisWorkbook.Path & "\" & ZstrTable = "[sheet1$A2:h65536]"上述代码分别给出了文件的路径名称和数据表的范围，数据的范围是sheet1工作表除去表头后的全部$A2:h65536.3 strSQL = "select F1,F2,F3,F4,F5 from " & strTableRange("A" & x).CopyFromRecordset cnADO.Execute(strSQL)建立连接后把需要的数据拷贝出来，需要的数据是第1列，第2列，第3列，第4列 ，第5列4 x = Range("b65536").End(xlUp).Row 下次复制的位置确定.5 Z = Dir特别注意：第一次调用 Dir 函数时，必须指定 pathname，否则会产生错误。如果也指定了文件属性，那么就必须包括 pathname。Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。不必访问到所有匹配当前 pathname 的文件名，就可以改变到一个新的 pathname 上。但是，不能以递归方式来调用 Dir 函数。以 vbDirectory 属性来调用 Dir 不能连续地返回子目录。由于文件名并不会以特别的次序来返回，所以可以将文件名存储在一个数组中，然后再对这个数组排序。上述的Z=dir 就是实现的下一个文件名的调用。下面看运行的结果：点击“ADO实现同文件夹下所有文件数据汇总”按钮：汇总后再A到E列给出了数据的汇总：今日内容回向：1 在不知道文件名和文件个数的前提下，如何汇总文件？2 DIR函数的意义是否理解？
Ⅹ 如何用vba依次打开本文件夹中所有文件 ，统计每个文件夹中的数据 ，并
Sub合()DimrangeArray()AsStringDimbkAsWorkbookDimshtAsWorksheetDimwbCountAsIntegerwbCount=Workbooks.CountReDimrangeArray(1TowbCount-1)ForEachbkInWorkbooksIfNotbkIsThisWorkbookThenSetsht=bk.Worksheets(1)i=i+1rangeArray(i)="'["&bk.Name&"]"&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)EndIfNextWorksheets(1).Range("A1").ConsolidaterangeArray,xlSum,True,True'汇总多个工作薄的第一个工作表Setsht=NothingEndSub
这是一个将当前工作薄中的所有除当前打开的工作薄的数据汇总到当前工作薄的代码，供您参考。
您的各表中的数据结构不清楚，不好处理。这代码也不是本人写的。本人也是在此基础上根据自己的需要另写代码处理自己的问题的。
希望能帮到您。
