想弄一个打开文件夹选择一个xls文件，然后把8个数据写入到对应的表格中

qinshuai8507

想弄一个打开文件夹选择一个xls文件，然后把8个数据写入到对应的表格中，请各位老师赐教。

ykcbf1100

上一个附件吧，这样容易解决问题。

附件必须压缩后才能上传。

gwjkkkkk

上传附件，模拟结果。。。

fzxba

1. Sub test0()
   
2.   
   
3.   Dim strFile As String
   
4.   With Application.FileDialog(msoFileDialogFilePicker)
   
5.     .InitialFileName = ThisWorkbook.Path
   
6.     With .Filters
   
7.       .Clear
   
8.       .Add "Excel Files", "*.xls?"
   
9.     End With
   
10.     .AllowMultiSelect = False
    
11.     If .Show Then strFile = .SelectedItems(1) Else Exit Sub
    
12.   End With
    
13.   
    
14.   Application.ScreenUpdating = False
    
15.   
    
16.   With Workbooks.Open(strFile, 0)
    
17.     With .Worksheets("什么表")
    
18.       .Range("A1") = "第1个数据"
    
19.       '………………
    
20.       .Range("A8") = "第8个数据"
    
21.     End With
    
22.     .Close True
    
23.   End With
    
24.   
    
25.   Application.ScreenUpdating = True
    
26. End Sub

复制代码

qinshuai8507

ykcbf1100 发表于 2024-3-20 11:35
上一个附件吧，这样容易解决问题。

附件必须压缩后才能上传。

您好，开始没说清楚，已上传附件，就是想用那个宏修改把数据填上，然后选择数据库文件夹中的文件直接不用打开excel写入相应的单元格就行

qinshuai8507

fzxba 发表于 2024-3-20 11:46

谢谢，是开始没说清楚，已上传附件，就是想用那个宏修改把数据填上，然后选择数据库文件夹中的文件直接不用打开excel写入相应的单元格就行，您给的这个我试了下实现不了

qinshuai8507

gwjkkkkk 发表于 2024-3-20 11:36
上传附件，模拟结果。。。

您好，开始没说清楚，已上传附件，就是想用那个宏修改把数据填上，然后选择数据库文件夹中的文件直接不用打开excel写入相应的单元格就行

fzxba

qinshuai8507 发表于 2024-3-20 14:12
谢谢，是开始没说清楚，已上传附件，就是想用那个宏修改把数据填上，然后选择数据库文件夹中的文件直接不 ...

1.   Dim strPath As String, strFile As String
   
2. '  With Application.FileDialog(msoFileDialogFolderPicker)
   
3. '    .InitialFileName = ThisWorkbook.Path
   
4. '    If .Show Then strPath = .SelectedItems(1) Else: Exit Sub
   
5. '  End With
   
6. '  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
7.   
   
8.   Dim Conn As Object
   
9.   Dim strConn As String, SQL As String, s As String
   
10.   
    
11.   Application.ScreenUpdating = False
    
12.   
    
13.   Set Conn = CreateObject("ADODB.Connection")
    
14.   
    
15.   s = "Excel 12.0;HDR=YES;Database="
    
16.   If Application.Version < 12 Then
    
17.     s = Replace(s, "12.0", "8.0")
    
18.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=YES';Data Source="
    
19.   Else
    
20.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=YES';Data Source="
    
21.   End If
    
22.   'Conn.Open strConn & ThisWorkbook.FullName
    
23.   
    
24.   strPath = ThisWorkbook.Path & "\数据库\"
    
25.   strFile = Dir(strPath & "*.xls?")
    
26.   
    
27.   SQL = "INSERT INTO [Sheet1$] SELECT * FROM [" & s & ThisWorkbook.FullName & "].[Sheet1$A1:H2]"
    
28.   
    
29.   While Len(strFile)
    
30.     'If strPath & strFile <> ThisWorkbook.FullName Then
    
31.     With Conn
    
32.       .Open strConn & strPath & strFile
    
33.       .Execute (SQL)
    
34.       .Close
    
35.     End With
    
36.     'End If
    
37.     strFile = Dir
    
38.   Wend
    
39.   
    
40.   If Conn.State = 1 Then Conn.Close
    
41.   Set Conn = Nothing
    
42.   
    
43.   Application.ScreenUpdating = True
    
44.   Beep
    
45. End Sub

复制代码

fzxba

少复制代码一行见附件.zip (29.52 KB, 下载次数: 7)

2024-3-20 14:52 上传

点击文件名下载附件

ykcbf1100

qinshuai8507 发表于 2024-3-20 14:11
您好，开始没说清楚，已上传附件，就是想用那个宏修改把数据填上，然后选择数据库文件夹中的文件直接不用 ...

附件供参考。。。