打开文件夹下所有excel文件并复制数据,对于已存在的数据进行更新,对于新数据进行添加。
Sub copydata()
Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
'显示打开文件夹对话框
With Application.FileDialog(msoFileDialogFolderPicke r)
.Show
If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
strFolder = .SelectedItems(1)
End With
'获取文件夹中的所有文件列表
varFileList = fcnGetFileList(strFolder)
If Not IsArray(varFileList) Then
MsgBox '未找到文件', vbInformation
Exit Sub
End If
'获取文件的详细信息,并放到数组中
ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)
myResults(0, 0) = '文件名'
Set FSO = CreateObject('Scripting.FileSystemObject')
For l = 0 To UBound(varFileList)
Set myFile = FSO.GetFile(CStr(varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
Workbooks.Open (myResults(l + 1, 0))
Dim arr(0 To 100, 0 To 100) As String
'获取文件中的数据给二维数组赋值
F
Sub copydata()
Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
'显示打开文件夹对话框
With Application.FileDialog(msoFileDialogFolderPicke
.Show
If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
strFolder = .SelectedItems(1)
End With
'获取文件夹中的所有文件列表
varFileList = fcnGetFileList(strFolder)
If Not IsArray(varFileList) Then
MsgBox '未找到文件', vbInformation
Exit Sub
End If
'获取文件的详细信息,并放到数组中
ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)
myResults(0, 0) = '文件名'
Set FSO = CreateObject('Scripting.FileSystemObject')
For l = 0 To UBound(varFileList)
Set myFile = FSO.GetFile(CStr(varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
Workbooks.Open (myResults(l + 1, 0))
Dim arr(0 To 100, 0 To 100) As String
'获取文件中的数据给二维数组赋值
F
