VBA一键提取广东省工资系统《个人信息采集表》A3版本

Sub yhd一键提取广东省工资系统个人信息A3版本()
    Dim mysht As Worksheet
    Dim fold As String, file, data_arr()
    Dim myobj As Object
    Dim file_num
    file_num = 0
  
    Set mysht = Sheets("提取A3")
    fold = SelectGetFolder
    If fold = "没有选择" Then Exit Sub
    arr = GetPathAllFile(fold)
    Call AppEx(False)
    ti = Timer()
    With mysht
        .Range("a5").Resize(5000, 200).ClearContents
        xl_c = .Range("A1").End(xlToRight).Column
        ReDim data_arr(UBound(arr) - 1, xl_c - 1)
        start_arr = .Range("A1").Resize(2, xl_c)
        Debug.Print UBound(start_arr, 2), UBound(data_arr, 1) & "--" & UBound(data_arr, 2)
    End With
    For Each rr In arr
        Set myobj = GetObject(rr)
        With myobj
            With .Sheets("Sheet1")
                For i = 1 To xl_c
                    data_arr(file_num, i - 1) = .Range(start_arr(1, i))
                Next i
            End With
            .Close False
        End With
        file_num = file_num + 1
        Set myobj = Nothing
    Next
    With mysht.Range("a5").Resize(UBound(data_arr, 1) + 1, UBound(data_arr, 2) + 1)
        .NumberFormatLocal = "@"
        .Value = data_arr                                      'Application.Transpose(arr)
        .ShrinkToFit = True
    End With
    Call AppEx(True)
    MsgBox "完成！用时" & Format(Timer - ti, "0000.00秒")
End Sub