[發問] 請教,如何逐一開啟子資料夾內之文字檔至EXCEL

cmo140497

Dear 各位大大 :
可否請各位幫忙看一下,MYFNAME已找到子資料夾之文字檔,但卻開不起來無法逐一輸入,謝謝!

1. Public dic
   
2. Sub ListFi()
   
3. Dim mypath As String
   
4. Dim theSh As Object, E As Object, theFolder As Object
   
5. Dim i As Integer
   
6.    
   
7. 'Application.ScreenUpdating = False
   
8. On Error Resume Next
   
9.     Set theSh = CreateObject("shell.application")
   
10.     Set theFolder = theSh.BrowseForFolder(0, "", 0, "")
    
11.     If Not theFolder Is Nothing Then
    
12.         mypath = theFolder.Items.Item.Path
    
13.         'MsgBox mypath
    
14.     End If
    
15.    
    
16.     With CreateObject("Scripting.FileSystemObject").GetFolder(mypath)
    
17.         i = 1
    
18.         For Each E In .SubFolders
    
19.             If i > ActiveWorkbook.Sheets.Count Then
    
20.                 Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
    
21.             Else
    
22.                 Sheets(i).Name = E.Name
    
23.             End If
    
24.             '--------------------------------------------
    
25.    
    
26.         Dim MyTEXT As String, MYFNAME As String, WAFERID As String, ROWDATA_START As String
    
27.         Dim EE As Integer, FILENO As Integer
    
28.         
    
29.         'fs = Dir(fd & "*.txt")
    
30.                     EE = 4
    
31.                     On Error Resume Next
    
32.                     FILENO = FreeFile
    
33.                     MsgBox E.Name
    
34.                     fd = E & "\"
    
35.                     MYFNAME = Dir(fd & "*.txt")
    
36.                     'MYFNAME = Dir(E & "\", MacID("TEXT"))
    
37.                     If MYFNAME = "False" Then Exit Sub
    
38.                     Open MYFNAME For Input As #FILENO
    
39.                             WAFERID = "WAFER:"
    
40.                             ROWDATA_START = "RowData:"
    
41.                             'DEVICE = "DEVICE:"
    
42.                             'LOT = "LOT:"
    
43.                     'COLCT = "COLCT:"
    
44.                         Do While Not EOF(1)
    
45.                             Input #FILENO, MyTEXT
    
46.                                 'If Mytxt Like DEVICE & "*" Then
    
47.                                     'Cells(1, 1).Value = MyTEXT
    
48.                                 'End If
    
49.                                 'If Mytxt Like LOT & "*" Then
    
50.                                     'Cells(2, 1).Value = MyTEXT
    
51.                                 'End If
    
52.                                 If Mytxt Like WAFERID & "*" Then
    
53.                                     Cells(3, 1).Value = MyTEXT
    
54.                                 End If
    
55.                                  'If MYTXT Like COLCT & "*" Then
    
56.                                     'Cells(4, 1).Value = MYTXT
    
57.                                 'End If
    
58.                                 If Mytxt Like ROWDATA_START & "*" Then
    
59.                                     Cells(EE + 1, 1).Value = MyTEXT
    
60.                                     EE = EE + 1
    
61.                                 End If
    
62.                         Loop
    
63.                     Close #FILENO
    
64. '----------------------------------------------------------
    
65.             ii = 12
    
66.            For Each P In E.Files
    
67.                 '------------------------------------------
    
68.                    If InStr(UCase(P.Name), ".JPG") Then
    
69.                         ActiveWindow.Zoom = 70
    
70.                         Worksheets(i).Activate
    
71.                         '--設定圖片欄位大小
    
72.                         With Sheets(i).Cells(ii, 2).Select
    
73.                             With Selection
    
74.                             .RowHeight = 82
    
75.                             .ColumnWidth = 17
    
76.                             .WrapText = True
    
77.                             End With
    
78.                             '--設定圖片位置及長寬
    
79.                             t = Cells(ii, 2).Top + Cells(ii, 2).Height * 0.04  '圖片上位置
    
80.                             L = Cells(ii, 2).Left + Cells(ii, 2).Width * 0.04 '圖片左位置
    
81.                             w = 75                                       '圖片縮小75%寬度
    
82.                             h = 75                                  '圖片縮小75%高度
    
83.                             '--開始插入圖片
    
84.                                 With Sheets(i).Shapes.AddPicture(P, True, True, L, t, w, h)
    
85.                                 .Placement = xlMove
    
86.                                         With Sheets(i)
    
87.                                         .Cells(ii, 1) = P.Name                          '圖片檔案名稱
    
88.                                         '.Cells(ii, 1) = P                              '圖片檔案完整路徑
    
89.                                         End With
    
90.                                 End With
    
91.                             End With
    
92.                         ii = ii + 1    '一次跳的欄位數
    
93.                     
    
94.                 End If   '--get .jpg file
    
95.             Next
    
96.             
    
97.             i = i + 1
    
98.         Next
    
99.     End With
    
100.     'Sheets.Add After:=Sheets(Sheets.Count)
     
101.    
     
102. End Sub
     
103. Sub nn()
     
104. With ActiveSheet.Shapes(Application.Caller)
     
105.     If .Left = ActiveSheet.[A1].Left Then
     
106.         .Top = dic(.Name)(0)
     
107.         .Left = dic(.Name)(1)
     
108.         .Height = dic(.Name)(2)
     
109.         .Width = dic(.Name)(3)
     
110.     Else
     
111.         .Height = dic(.Name)(2) * 3
     
112.         .Width = dic(.Name)(3) * 3
     
113.         .Top = ActiveSheet.[A1].Top
     
114.         .Left = ActiveSheet.[A1].Left
     
115.         '.ZOrder msoBringToFront
     
116.     End If
     
117. End With
     
118. End Sub

複製代碼

000-Start.zip (18.29 KB)

下載次數: 6

2013-1-9 14:44

cmo140497

回復 1# cmo140497


    歹勢,小弟找到了,應在Open fd & MYFNAME For Input As #FILENO