关于VBA获取未打开文件的工作表名

uling

大家好,小弟这边有个问题请大家帮忙

现有文件F:\test\test.xls,文件中有工作表test1,test2....

我打开另一个文件F:\test\total.xls,在文件test.xls未打开的情况下,如果获取test.xls中的工作表名(test1,test2,....),并写入在total.xls中的指定工作表中

cflood

不打开文件读取文件内容是不可能的，可以打开后读取内容再关闭

uling

原帖由 cflood 于 2009-12-18 20:07 发表
不打开文件读取文件内容是不可能的，可以打开后读取内容再关闭

可以的,以下代码就是我从中截取的,我运行过,可以实现对已知的工作表名取数,但无法获取工作表名
     Arg = "'" & MyAllFiles(l, 1) & "[" & CStr(varFileList(l)) & "]" & MyAllFiles(l, 2) & "'!" & Cells(M, 3).Range("A1").Address(, , xlR1C1)
        If ExecuteExcel4Macro(Arg) = "" Then Exit For '如果记录为空,则跳出For循环
        MyCount = Sheet1.UsedRange.Rows.Count
        For N = 1 To 17
            Arg = "'" & MyAllFiles(l, 1) & "[" & CStr(varFileList(l)) & "]" & MyAllFiles(l, 2) & "'!" & Cells(M, N).Range("A1").Address(, , xlR1C1)
            Sheet1.Cells(MyCount + 1, N) = ExecuteExcel4Macro(Arg)
            Sheet1.Cells(MyCount + 1, 18) = MyAllFiles(l, 2)
        Next N

[ 本帖最后由 uling 于 2009-12-18 20:22 编辑 ]

cflood

比如在单元格里输入='F:\[book1.xls]sheet1'!$A$6
虽然你看着没有打开excel窗口，但在后台肯定会打开这个文件的。

uling

和你说的不是一个概念的
这里主要是用到ExecuteExcel4Macro

masterexcel

关注一下。

lipton

请测试：ADOX方法

Sub AdoTs()

Dim cat
Dim cnn
Dim c

    Set cnn = CreateObject("ADODB.Connection")
    Set cat = CreateObject("ADOX.Catalog")
    cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='Excel 8.0';Data Source = " _
            & "F:\test\test.xls"
   
    Set cat.ActiveConnection = cnn
    For Each c In cat.Tables
        MsgBox c.Name
    Next c
    Set c = Nothing
    Set cat.ActiveConnection = Nothing
    Set cat = Nothing
    Set cnn = Nothing

End Sub

cflood

原帖由 uling 于 2009-12-18 20:33 发表
和你说的不是一个概念的
这里主要是用到ExecuteExcel4Macro

不要说ExecuteExcel4Macro，就是系统调用dll里的过程也要把dll文件打开才行，要不怎么读取过程内容，只不过没有窗口罢了。

detergent181

Sub abc()
Set mycn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Dim tb As String
mystr = "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\abc.xls"
mycn.CursorLocation = adUseClient
mycn.Open mystr
Set rs = mycn.OpenSchema(adSchemaTables)
For i = 1 To rs.RecordCount
   MsgBox rs.Fields("TABLE_NAME")
    rs.MoveNext
Next
Set mycn = Nothing: Set rs = Nothing
End Sub
但测了不太准确，楼上的SQL方法，也不太准确,我也试了。
我的附件中的只有一个工作表，但还有一些定义了名称的区域，而SQL把这名称区域，也当作了表。数据库中的表与工作薄中的表，不是一个概念。
不知道OpenSchema()，还有没有其它的参数，能达到更准确。

代码在123中。

[ 本帖最后由 detergent181 于 2009-12-18 22:18 编辑 ]

lipton

原帖由 detergent181 于 2009-12-18 22:15 发表
Sub abc()
Set mycn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Dim tb As String
mystr = "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= ...

代码测试了，以前没有发现定义名称这个问题，谢谢
测试后发现命名和表名稍微不同，如下：
axc
'page 1$'《=表名
'page 1$'Print_Area〈=定义名称
'page 1$'Print_Titles〈=定义名称

运行的代码：
Sub AdoTs()

Dim cat
Dim cnn
Dim c

    Set cnn = CreateObject("ADODB.Connection")
    Set cat = CreateObject("ADOX.Catalog")
    cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='Excel 8.0';Data Source = " _
            & ThisWorkbook.Path & "\abc.xls"
   
    Set cat.ActiveConnection = cnn
    For Each c In cat.Tables
        Debug.Print c.Name
    Next c
    Set c = Nothing
    Set cat.ActiveConnection = Nothing
    Set cat = Nothing
    Set cnn = Nothing

End Sub