分析保存，列子成功，

zgzyd2020

为何我的不成功！！！谢谢前期老师的大作

Sub test()
  Dim Cn As Object, p$, f$, ar$(), i&
  DoApp False
  Set Cn = CreateObject("ADODB.Connection")
  Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & ThisWorkbook.FullName
  p = ThisWorkbook.Path & "\报表11\季报\外审" & Application.PathSeparator
  ar = Split("G01附注VII  g1103 ")
  For i = 0 To UBound(ar)
    f = p & ar(i) & ".xlsx": If Len(Dir(f)) > 0 Then Kill f
   
    Cn.Execute "SELECT * INTO [" & f & "].[" & ar(i) & "] FROM [" & ar(i) & "$" & Worksheets(ar(i)).Range("A1").CurrentRegion.Address(0, 0) & "]"
  Next




End Sub
Function DoApp(Optional b As Boolean = True)
  With Application
    .ScreenUpdating = b
    .DisplayAlerts = b
    If b = True Then .Calculation = xlCalculationAutomatic Else .Calculation = xlCalculationManual
'    .EnableEvents = b
  End With
End Function