lz小白，想用VB写一个程序对excel进行操作，运行到 .Range("A2").CopyFromRecordset conn.Execute(Sql) 出现用于查看已链接的microsoft excel文件的连接，已经丢失
Private Sub CommandButtonGenerate_Click()
Set xlsApp = CreateObject("excel.application")
xlsApp.Visible = True
Set xlsBook = xlsApp.Workbooks.Open(TextBoxDIR.Text, , False)
Set xlsSheet = xlsBook.Worksheets(1)
xlsSheet.Activate
Dim myRange As Variant
Dim myArray
Dim titleRange As Range
Dim title As Variant
Dim columnNum As Integer
myRange = Range("A1:L1")
myArray = WorksheetFunction.Transpose(myRange)
Set titleRange = Range("A1")
title = titleRange.Value
columnNum = titleRange.Column
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Dim i&, Myr&, Arr, num&
Dim d, k, m
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> Worksheets(1).Name Then
Sheets(i).Delete
End If
Next i
Set d = CreateObject("Scripting.Dictionary")
Myr = Worksheets(1).UsedRange.Rows.Count
Arr = Worksheets(1).Range(Cells(2, columnNum), Cells(Myr, columnNum))
For i = 1 To UBound(Arr)
d(Arr(i, 1)) = ""
Next
k = d.keys
For i = 0 To UBound(k)
Set conn = CreateObject("adodb.connection")
m = xlsBook.FullName
conn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties=Excel 12.0 ;Data Source=" & xlsBook.FullName
Sql = "select * from [" & Worksheets(1).Name & "$] where " & title & " = '" & k(i) & "'"
xlsBook.Activate
Worksheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = k(i)
For num = 1 To UBound(myArray)
.Cells(1, num) = myArray(num, 1)
Next num
Set RS = conn.Execute(Sql)
.Range("A2").CopyFromRecordset conn.Execute(Sql)
iRows = ActiveSheet.UsedRange.Rows.Count
iCloumns = ActiveSheet.UsedRange.Columns.Count
End With
Sheets(1).Select
Sheets(1).Cells.Select
Selection.Copy
Worksheets(Sheets.Count).Activate
ActiveSheet.Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With ActiveSheet
.Range(Cells(1, 1), Cells(iRows, iCloumns)).Borders.LineStyle = 1
End With
Rows(1).Insert
Range(Cells(1, 1), Cells(1, UBound(k))).Merge
Range("A1").Font.Size = 40
Range("A1").HorizontalAlignment = xlCenter
Range("A1") = Range("C3")
Next i
conn.Close
Set conn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub在VBA中可以正常运行，需要怎么修改才能在VB中运行
不知道你这个问题是否已经解决, 如果还没有解决的话: