返回列表 上一主題 發帖

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

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-1-9 14:45 | 只看該作者

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

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)
收藏 分享

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
2#
發表於 2013-1-9 15:00 | 只看該作者
回復 1# cmo140497


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

TOP

        靜思自在 : 待人退一步，愛人寬一寸，就會活得很快樂。
返回列表 上一主題