指定字段数据提取行数问题

Optional ByVal FileFilter As String = *.*， False) LASTROW = SH1.Range(A1048576).End(3).Row + 1 SH1.Range(A LASTROW).Resize(UBound(SQLARR， UBound(SQLARR， vbDirectory) Do While MyName If MyName . And MyName .. Then If (GetAttr(Ke(I) MyName) And vbDirectory) = vbDirectory Then DIC.Add (Ke(I) MyName \)， 提取 ，。

strSplitor， Optional ByVal strSplitor As String = \) As String Dim FileName1 As String Dim FNAME As String FileName1 = Left$(strFullPath， InStrRev(strFullPath， End If End If MyName = Dir Loop End If I = I + 1 Loop Dim arrx() As String I = 0 ReDim arrx(I) arrx(I) = If Files = True Then For Each Ke In DIC.keys ReDim Preserve arrx(I) If Ke Filename Then arrx(I) = Ke I = I + 1 End If Next FileAllArr = arrx Else For Each Ke In DIC.keys MyFileName = Dir(Ke FileFilter) Do While MyFileName If MyFileName Liwai Then ReDim Preserve arrx(I) arrx(I) = Ke MyFileName I = I + 1 End If MyFileName = Dir Loop Next FileAllArr = arrx End If End Function 代码， Optional ByVal Files As Boolean = False) As String() Dim DIC， I = 0 Do While I DIC.Count Ke = DIC.keys If SubFiles = True Then MyName = Dir(Ke(I)， \)， ， 数据提取工具 End Sub Public Function GetPathFromFileName(ByVal strFullPath As String， .) - 1) Else GetPathFromFileName = FileName1 End If End Function Public Function FileAllArr(ByVal Filename As String， MyName，为什么使用该代码提取的文件只提取到了65538行就中断了？ 请帮忙检查下代码， Optional ByVal Liwai As String = ， *.xls?， 2) + 1) = SQLARR Next WB.Close False Set WB = Nothing Next End If Application.EnableEvents = True Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox 数据提取耗时： Format(Timer - T， Str_coon， Optional ByVal SubFiles As Boolean = True。

ICOL).Value ] Next FileArr = FileAllArr(ThisWorkbook.Path， \\，' SH.Name ' AS 工作表名 StrSQL = StrSQL StrBT StrSQL = StrSQL FROM [ SH.Name $A SH1.Range(B1).Value :HZ] SQLARR = GET_SQL_To_Arr(StrSQL， X As Integer Dim Str_coon， 指定。

#0.0000) 秒， \) DIC.Add (Filename)， InStrRev(FileName1， 数据， ，[ SH1.Cells(3， False) If FileArr(0) Then ICOUNT = UBound(FileArr) + 1 For I = 0 To ICOUNT - 1 Str_coon = HDR=yes';Data Source = FileArr(I) Set WB = Workbooks.Open(FileArr(I)) For Each SH In WB.Worksheets StrSQL = SELECT ' GetPathFromFileName(FileArr(I)) ' AS 工作簿名 StrSQL = StrSQL ， \\， FileName1， 字段。

) If kzm = False Then GetPathFromFileName = Left(FileName1， StrSQL As String Dim SH1， 指定字段数据提取代码如下， MyFileName Dim I As Long Set DIC = CreateObject(Scripting.Dictionary) Set DID = CreateObject(Scripting.Dictionary) Filename = Replace(Replace(Filename \， True， vbTextCompare)) FileName1 = Replace(strFullPath，谢谢! Sub Opiona() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Dim T T = Timer Dim SQLARR Dim I， 1) + 1， Optional ByVal kzm As Boolean = False， DID， ThisWorkbook.Name，但是源文件杭州超过65538行， SH0， SHW As Worksheet Set SH1 = Sheets(数据提取) SH1.Range(A4:HZ1048576).ClearContents StrBT = For ICOL = 3 To SH1.Range(HZ3).End(xlToLeft).Column StrBT = StrBT ， Ke。