|
原帖由 themagic007 于 2008-11-11 21:07 发表
大佬,我错了,盗用你的代码,还骂你小样~小弟有眼不识泰山,得罪之处 敬请原谅[:24]
这还差不多,别忘了带我向你女朋友问候问候哦。
- Private Sub Command0_Click()
- Dim DiaFs As FileDialog
- Dim fs As New FileSystemObject
- Dim fd As Folder
- Dim f As File
- Dim i As Integer
- On Error GoTo Command0_Click_Error
- Set DiaFs = Application.FileDialog(msoFileDialogFolderPicker)
- DiaFs.AllowMultiSelect = False
- DiaFs.Show
- Me.Text1 = DiaFs.SelectedItems(1)
- If DiaFs.SelectedItems.Count > 0 Then
- Me.Text1 = DiaFs.SelectedItems(1)
- Else
- MsgBox "请选择要导入excel所在的文件夹"
- Me.Command0.SetFocus
- Exit Sub
- End If
- Set fd = fs.GetFolder(Me.Text1)
- For Each f In fd.Files
- If Right(f.Name, 3) = "xls" Then
- i = i + 1
- DoCmd.TransferSpreadsheet acImport, , "XL" & i & "_" & Format(Date, "mmm"), _
- Left(f.Name, Len(f.Name) - 4)
- End If
- Next
- On Error GoTo 0
- Exit Sub
- Command0_Click_Error:
- MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
- End Sub
复制代码 |
|