質問編集履歴

1

ソース間違いのため差し替えいたしました

2018/10/30 02:41

投稿

yuujiMotoki
yuujiMotoki

スコア90

test CHANGED
File without changes
test CHANGED
@@ -14,25 +14,11 @@
14
14
 
15
15
  現状のソースを下記に示します。
16
16
 
17
- どうもDAOを使った方法が故に遅くなっているのかもしれません。
18
17
 
19
18
 
20
19
 
21
- RS.AddNew
22
20
 
23
- RS!対象 = True
24
-
25
- RS!Type = "xlsm"
26
-
27
- RS!File = Row(UBound(Row))
28
-
29
- RS!更新日 = Row(0) & " " & Row(2)
21
+ DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTblName, strPath, True, sheet & "!"
30
-
31
- RS!Path = File_opt
32
-
33
- RS.Update
34
-
35
- count = count + 1
36
22
 
37
23
 
38
24
 
@@ -44,137 +30,107 @@
44
30
 
45
31
 
46
32
 
47
- Attribute VB_Name = "ClsICTData"
33
+ Public TableNames As Collection
34
+
35
+ Private qdf As DAO.QueryDef
36
+
37
+ Dim myRS As DAO.Recordset
38
+
39
+ Private sql As String
40
+
41
+ Private xlPath As String
48
42
 
49
43
 
50
44
 
51
- Option Compare Database
45
+ Public Sub tablename()
52
46
 
47
+ Dim FSO As FileSystemObject
48
+
49
+ Dim filenum As Variant
50
+
53
- Option Explicit
51
+ Dim table As Variant
52
+
53
+ Dim FIO As ClsFileIO
54
+
55
+ Set FIO = New ClsFileIO
56
+
57
+ Dim bar As Variant: Set bar = New clsProgressBar
58
+
59
+ Dim count_all
60
+
61
+ Dim count
62
+
63
+ count_all = TableNames.count
54
64
 
55
65
 
56
66
 
57
- Private DB As Database
67
+ For Each filenum In TableNames
58
68
 
59
- Private RS As Recordset
69
+ With filenum
60
70
 
61
- Private FSO As FileSystemObject
71
+ Dim tbln
62
72
 
63
- Private TS As TextStream:
73
+ tbln = StrConv(.tbl, 4)
64
74
 
65
- Private FileName As Variant
75
+ FIO.Import .Path & "\" & .File, "Lot結果", "Lot結果"
66
76
 
67
- Private TestNum As Variant
77
+ bar.UpdateProgress count, count_all, filenum.File, Form_frmProgressBar
68
78
 
69
- Private FileNumber As Variant
79
+ count = count + 1
70
80
 
71
- Private DIR_CSV As Variant
81
+ End With
72
82
 
73
- Private Mode As Variant
83
+ Next
74
-
75
- Private File_opt As Variant
76
-
77
- Private FILETXT As Variant
78
84
 
79
85
 
80
-
81
- Property Let FileName_(obj As Variant): FileName = obj: End Property
82
-
83
- Property Let TestNum_(obj As Variant): TestNum = obj: End Property
84
-
85
- Property Let FILETXT_(obj As Variant): FILETXT = obj: End Property
86
-
87
- Property Set RS_(obj As Variant): Set RS = DB.OpenRecordset(obj): End Property
88
-
89
- Property Let File_Opt_(obj As Variant): File_opt = obj: End Property
90
-
91
-
92
-
93
- Public Sub ImportCSVFiles()
94
-
95
-
96
-
97
- Dim TS As TextStream:
98
-
99
- Dim filenum As Variant
100
-
101
- Dim count_ini: count_ini = 0
102
-
103
- Dim count: count = 0
104
-
105
- Dim msg
106
-
107
- Dim rec
108
-
109
- Dim fsoObj
110
-
111
- Dim progb
112
-
113
- ReadRecord
114
-
115
- RS.Close
116
-
117
- DB.Close
118
86
 
119
87
  End Sub
120
88
 
121
89
 
122
90
 
123
- Private Sub ReadRecord()
124
91
 
125
- Dim Row As Variant
126
92
 
127
- Dim count: count = 0
128
93
 
129
- Dim dum As Variant
130
94
 
131
- Set TS = FSO.OpenTextFile(FILETXT, ForReading)
95
+ Public Sub Import(strPath As Variant, strTblName As Variant, sheet As Variant)
132
96
 
133
- Do Until TS.AtEndOfStream
97
+ On Error GoTo err
134
98
 
135
- dum = TS.ReadLine
136
99
 
137
- If Not dum Like "*.xlsm" Then GoTo xxx
138
100
 
139
- Row = Split(dum, " ")
101
+ Select Case OdbcSelect(strPath)
140
102
 
103
+ Case ACCESS
104
+
105
+ DoCmd.TransferDatabase acImport, "Microsoft Access", _
106
+
141
- If UBound(Row) < 1 Then GoTo xxx
107
+ strPath, acTable, strTblName, strTblName
108
+
109
+ Exit Sub
142
110
 
143
111
 
144
112
 
145
- RS.AddNew
113
+ Case EXCEL
146
114
 
147
- RS!対象 = True
115
+ DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTblName, strPath, True, sheet & "!"
148
116
 
149
- RS!Type = "xlsm"
150
117
 
151
- RS!File = Row(UBound(Row))
152
118
 
153
- RS!更新日 = Row(0) & " " & Row(2)
119
+ Exit Sub
154
120
 
155
- RS!Path = File_opt
121
+ Case Else
156
122
 
157
- RS.Update
123
+ End Select
158
124
 
159
- count = count + 1
160
125
 
161
- xxx: Loop
162
126
 
163
- TS.Close
127
+ err: MsgBox "テーブル構造が違います"
164
128
 
165
- MsgBox "データリスト更新しました。 " & count & "files"
129
+
166
130
 
167
131
  End Sub
168
132
 
169
133
 
170
-
171
- Private Sub Class_Initialize()
172
-
173
- Set DB = CurrentDb
174
-
175
- Set FSO = New FileSystemObject
176
-
177
- End Sub
178
134
 
179
135
 
180
136