如何用vba 代码打开一个文件夹内的一个<em>word</em> 文档？-word vba文档

试一下以知下代码道, 祝你成功!内
Dim fcc,fo,fso
Set fso = CreateObject("Scripting.filesystemobject")
Set fo = fso.getfolder("C:\AA") 容'文件夹
i=1
For Each fc In fo.subFolders
For Each fcc In fc.Files
If InStr(1, fcc.Name, ".doc", 1) Then
Range("A" & i) = fcc.Name
i = i + 1
End If
Next
Next

Sub Read_Word()
Dim worDoc As object
Dim wordappl As object
Dim mydoc As String
Dim myappl As String
mydoc = thisworkbook.path & "\" & "文件名.doc"　　　
'本文档目录下的doc文件，这里可以直接改成路径＋文e799bee5baa6e79fa5e98193e59b9ee7ad94331件名的形式
Set wordappl = CreateObject("Word.application")　　'设置wordappl对象
Set worDoc = wordappl.Documents.Open(mydoc)　
'打开word文档，mydoc变量指定路径和文件名
worDoc.Activate　　'激活打开的文档
wordappl.Selection.WholeStory '全选文档
wordappl.Selection.Copy　　'复制选择内容到剪贴板
worDoc.Application.Quit　　'关闭word文档
Set WordApp = Nothing　　'释放对象变量的内存
Workbooks(1).Sheets(2).Activate '激活excel第一个工作簿的第二个工作表
ActiveSheet.UsedRange.Clear　　　'把当前工作表清空，如果有重要数据，这条删除
Cells(1, 1).Select　　　　'选择A1单元格
ActiveSheet.Paste　　'粘贴复制的内容
wordappl.quit
set wordappl =nothing
End Sub
处理思路为：制作一个Doc文档，里边包含处理过程的代7a64e4b893e5b19e336码。需要使用时，将这个doc文档置于需要处理文档所在文件夹中，执行代码即可自动完成。如此即可达到一劳永逸的效果。

为便于使用，建议此doc文档中放置一个命令按钮（CommandButton，可标记为“开始执行”），一个可供显示处理过的文档名称的列表框（ListBox），单击命令按钮执行需要的处理过程，列表显示文档名，过程结束进行相应的提示。

假设您已经置入了CommandButton和ListBox，请双击CommandButton进入代码编辑窗口，将以下代码复制进去，补充完整您需要的一些操作代码即告完成。

'下面是需要复制的代码：

On Error GoTo handerr:
'请先单击代码编辑窗口的菜单“工具/引用”勾选“Microsoft Scripting Runtime”
'否则将无法使用本代码块，放弃使用 Dir 函数是为了不受版本影响

Dim Str1 As String
Dim Fso As New FileSystemObject
Dim Fl As File
Dim Fd As Folder
Dim odoc As Word.Document

If MsgBox("您确实需要开始执行此过程吗？", vbQuestion + vbYesNo, "提示") = vbNo Then
Exit Sub
End If

'清除显示已经处理的文档名列表，如果不需要，把下面一句删除
ListBox1.Clear

Set Fd = Fso.GetFolder(ThisDocument.Path)

'处理每一个文档
For Each Fl In Fd.Files
Str1 = LCase(Fl.Name)

If InStr(1, Str1, ".doc") > 0 And InStr(1, Str1, "~") = 0 And Str1 <> ThisDocument.Name Then
'如果不需要显示处理的文档名列表，请删除下面一句
ListBox1.AddItem Fl.Name

Set odoc = Documents.Open(CStr(Fl))
odoc.Activate

'下面填写您需要在打开文档后的一些处理动作，如设置页眉，插入图片等

'上面填写您需要处理的一些动作
odoc.Save '保存此文档
odoc.PrintOut '打印此文档
odoc.Close '关闭此文档
End If
Next Fl

'如果上面删除了列表显示语句，请把下面4行删除，再用最后一行进行操作结束
If ListBox1.ListCount > 0 Then
MsgBox "过程执行完毕！" & vbCrLf & "列表中的" & ListBox1.ListCount & "个文档等待打印机打印。", vbInformation, "提示"
Else
MsgBox "过程结束，没有任何文档可操作！", vbInformation, "提示"
End If

'msgbox "过程结束！",vbInformation,"提示"

Exit Sub

handerr:
MsgBox Err.Description, vbInformation, "错误提示"

Sub Read_Word()
Dim worDoc As object
Dim wordappl As object
Dim mydoc As String
Dim myappl As String
mydoc = thisworkbook.path & "\" & "文件名.doc"　　e79fa5e98193e58685e5aeb9362　
'本文档目录下的doc文件，这里可以直接改成路径＋文件名的形式
Set wordappl = CreateObject("Word.application")　　'设置wordappl对象
Set worDoc = wordappl.Documents.Open(mydoc)　
'打开word文档，mydoc变量指定路径和文件名
worDoc.Activate　　'激活打开的文档
wordappl.Selection.WholeStory '全选文档
wordappl.Selection.Copy　　'复制选择内容到剪贴板
worDoc.Application.Quit　　'关闭word文档
Set WordApp = Nothing　　'释放对象变量的内存
Workbooks(1).Sheets(2).Activate '激活excel第一个工作簿的第二个工作表
ActiveSheet.UsedRange.Clear　　　'把当前工作表清空，如果有重要数据，这条删除
Cells(1, 1).Select　　　　'选择A1单元格
ActiveSheet.Paste　　'粘贴复制的内容
wordappl.quit
set wordappl =nothing
End Sub