怎么导入另外一个文件并重新命名sheet

小女孩

求助.rar (1.86 MB, 下载次数: 4)

2022-12-2 09:48 上传

点击文件名下载附件

导入后并重新命名怎么办？谢谢哪位帮我看一下！

fzxba

1. Sub test_csv()
   
2.   Dim strFile As String
   
3.   With Application.FileDialog(msoFileDialogOpen) '1
   
4.     .InitialFileName = ThisWorkbook.Path
   
5.     With .Filters
   
6.       .Clear
   
7.       .Add "CSV Files", "*.csv"
   
8.     End With
   
9.     .AllowMultiSelect = False
   
10.     If .Show Then strFile = .SelectedItems(1) Else Exit Sub
    
11.   End With
    
12.   
    
13.   Application.ScreenUpdating = False
    
14.   
    
15.   Dim Conn As Object, rs As Object, SQL As String
    
16.   Dim p As String, f As String, i As Integer
    
17.   
    
18.   f = Split(strFile, "\")(UBound(Split(strFile, "\")))
    
19.   p = Replace(strFile, f, vbNullString)
    
20.   
    
21.   Set Conn = CreateObject("ADODB.Connection")
    
22.   Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='text;HDR=yes;FMT=Delimited';Data Source=" & p
    
23.   
    
24.   SQL = "SELECT * FROM [" & f & "]"
    
25.   Set rs = Conn.Execute(SQL)
    
26.   With Worksheets(2)
    
27.     .UsedRange.Clear
    
28.     For i = 0 To rs.Fields.Count - 1
    
29.       .Range("A1").Offset(0, i) = rs.Fields(i).Name
    
30.     Next
    
31.     .Range("A2").CopyFromRecordset rs
    
32.     With .Range("A1").CurrentRegion
    
33.       .Borders.Weight = xlHairline
    
34.       .Columns(18).NumberFormatLocal = "hh:mm:ss"
    
35.     End With
    
36.     .Name = Split(f, ".csv")(0)
    
37.   End With
    
38.   
    
39.   Set rs = Nothing
    
40.   Conn.Close
    
41.   Set Conn = Nothing
    
42.   
    
43.   Application.ScreenUpdating = True
    
44.   Beep
    
45. End Sub

复制代码

fzxba

求助1202.rar (220.74 KB, 下载次数: 8)

2022-12-2 10:33 上传

点击文件名下载附件

ykcbf1100

动态选择文件并导入。

小女孩

fzxba 发表于 2022-12-2 10:27

请教一个问题，如果我导入.xls格式的文件，把.csv换掉，为什么不执行呢?帮我看一下，谢谢！

fzxba

小女孩 发表于 2022-12-5 12:02
请教一个问题，如果我导入.xls格式的文件，把.csv换掉，为什么不执行呢?帮我看一下，谢谢！