質問編集履歴
1
ソース間違いのため差し替えいたしました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -6,88 +6,66 @@
|
|
|
6
6
|
EXCELシートからの取り込みに関して、もっと良い方法があれば教えていただきたいのですが
|
|
7
7
|
|
|
8
8
|
現状のソースを下記に示します。
|
|
9
|
-
どうもDAOを使った方法が故に遅くなっているのかもしれません。
|
|
10
9
|
|
|
11
|
-
RS.AddNew
|
|
12
|
-
RS!対象 = True
|
|
13
|
-
RS!Type = "xlsm"
|
|
14
|
-
RS!File = Row(UBound(Row))
|
|
15
|
-
RS!更新日 = Row(0) & " " & Row(2)
|
|
16
|
-
RS!Path = File_opt
|
|
17
|
-
RS.Update
|
|
18
|
-
count = count + 1
|
|
19
10
|
|
|
11
|
+
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTblName, strPath, True, sheet & "!"
|
|
20
12
|
|
|
21
13
|
|
|
14
|
+
|
|
22
15
|
```vb
|
|
23
16
|
|
|
24
|
-
|
|
17
|
+
Public TableNames As Collection
|
|
18
|
+
Private qdf As DAO.QueryDef
|
|
19
|
+
Dim myRS As DAO.Recordset
|
|
20
|
+
Private sql As String
|
|
21
|
+
Private xlPath As String
|
|
25
22
|
|
|
23
|
+
Public Sub tablename()
|
|
24
|
+
Dim FSO As FileSystemObject
|
|
25
|
+
Dim filenum As Variant
|
|
26
|
-
|
|
26
|
+
Dim table As Variant
|
|
27
|
-
|
|
27
|
+
Dim FIO As ClsFileIO
|
|
28
|
+
Set FIO = New ClsFileIO
|
|
29
|
+
Dim bar As Variant: Set bar = New clsProgressBar
|
|
30
|
+
Dim count_all
|
|
31
|
+
Dim count
|
|
32
|
+
count_all = TableNames.count
|
|
28
33
|
|
|
29
|
-
Private DB As Database
|
|
30
|
-
Private RS As Recordset
|
|
31
|
-
Private FSO As FileSystemObject
|
|
32
|
-
Private TS As TextStream:
|
|
33
|
-
|
|
34
|
+
For Each filenum In TableNames
|
|
35
|
+
With filenum
|
|
36
|
+
Dim tbln
|
|
34
|
-
|
|
37
|
+
tbln = StrConv(.tbl, 4)
|
|
38
|
+
FIO.Import .Path & "\" & .File, "Lot結果", "Lot結果"
|
|
35
|
-
|
|
39
|
+
bar.UpdateProgress count, count_all, filenum.File, Form_frmProgressBar
|
|
36
|
-
Private DIR_CSV As Variant
|
|
37
|
-
|
|
40
|
+
count = count + 1
|
|
38
|
-
Private File_opt As Variant
|
|
39
|
-
|
|
41
|
+
End With
|
|
42
|
+
Next
|
|
40
43
|
|
|
41
|
-
Property Let FileName_(obj As Variant): FileName = obj: End Property
|
|
42
|
-
Property Let TestNum_(obj As Variant): TestNum = obj: End Property
|
|
43
|
-
Property Let FILETXT_(obj As Variant): FILETXT = obj: End Property
|
|
44
|
-
Property Set RS_(obj As Variant): Set RS = DB.OpenRecordset(obj): End Property
|
|
45
|
-
Property Let File_Opt_(obj As Variant): File_opt = obj: End Property
|
|
46
|
-
|
|
47
|
-
Public Sub ImportCSVFiles()
|
|
48
|
-
|
|
49
|
-
Dim TS As TextStream:
|
|
50
|
-
Dim filenum As Variant
|
|
51
|
-
Dim count_ini: count_ini = 0
|
|
52
|
-
Dim count: count = 0
|
|
53
|
-
Dim msg
|
|
54
|
-
Dim rec
|
|
55
|
-
Dim fsoObj
|
|
56
|
-
Dim progb
|
|
57
|
-
ReadRecord
|
|
58
|
-
RS.Close
|
|
59
|
-
DB.Close
|
|
60
44
|
End Sub
|
|
61
45
|
|
|
46
|
+
|
|
47
|
+
|
|
62
|
-
|
|
48
|
+
Public Sub Import(strPath As Variant, strTblName As Variant, sheet As Variant)
|
|
63
|
-
Dim Row As Variant
|
|
64
|
-
|
|
49
|
+
On Error GoTo err
|
|
65
|
-
|
|
50
|
+
|
|
66
|
-
Set TS = FSO.OpenTextFile(FILETXT, ForReading)
|
|
67
|
-
Do Until TS.AtEndOfStream
|
|
68
|
-
dum = TS.ReadLine
|
|
69
|
-
If Not dum Like "*.xlsm" Then GoTo xxx
|
|
70
|
-
|
|
51
|
+
Select Case OdbcSelect(strPath)
|
|
52
|
+
Case ACCESS
|
|
53
|
+
DoCmd.TransferDatabase acImport, "Microsoft Access", _
|
|
71
|
-
|
|
54
|
+
strPath, acTable, strTblName, strTblName
|
|
55
|
+
Exit Sub
|
|
72
56
|
|
|
73
|
-
RS.AddNew
|
|
74
|
-
RS!対象 = True
|
|
75
|
-
RS!Type = "xlsm"
|
|
76
|
-
RS!File = Row(UBound(Row))
|
|
77
|
-
RS!更新日 = Row(0) & " " & Row(2)
|
|
78
|
-
RS!Path = File_opt
|
|
79
|
-
RS.Update
|
|
80
|
-
count = count + 1
|
|
81
|
-
|
|
57
|
+
Case EXCEL
|
|
82
|
-
TS.Close
|
|
83
|
-
|
|
58
|
+
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTblName, strPath, True, sheet & "!"
|
|
84
|
-
End Sub
|
|
85
59
|
|
|
60
|
+
Exit Sub
|
|
61
|
+
Case Else
|
|
62
|
+
End Select
|
|
63
|
+
|
|
86
|
-
|
|
64
|
+
err: MsgBox "テーブル構造が違います"
|
|
87
|
-
|
|
65
|
+
|
|
88
|
-
Set FSO = New FileSystemObject
|
|
89
66
|
End Sub
|
|
90
67
|
|
|
68
|
+
|
|
91
69
|
```
|
|
92
70
|
|
|
93
71
|
読み込むシートは下記のようなデータで、４００行程度です。
|