質問編集履歴
5
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -1,55 +1 @@
|
|
|
1
|
-
windows8.1で動いていたvbsがwindows10で使用できなくなりました。
|
|
2
|
-
|
|
3
|
-
|
|
1
|
+
データフォルダの中にある、エクセルが例えば1つであれば、ポップアップは
|
|
4
|
-
|
|
5
|
-
Excel 16.0に修正しましたが、動きません。
|
|
6
|
-
|
|
7
|
-
|
|
8
|
-
|
|
9
|
-
他に修正箇所がわからないのでお教えいただきたくお願いいたします。
|
|
10
|
-
|
|
11
|
-
|
|
12
|
-
|
|
13
|
-
Option Explicit
|
|
14
|
-
|
|
15
|
-
Const DIR = "C:\Temp******\data"
|
|
16
|
-
|
|
17
|
-
Const XLS = "C:\Temp*********.xlsx"
|
|
18
|
-
|
|
19
|
-
|
|
20
|
-
|
|
21
|
-
Marge
|
|
22
|
-
|
|
23
|
-
Sub Marge
|
|
24
|
-
|
|
25
|
-
Dim cn
|
|
26
|
-
|
|
27
|
-
Dim rs
|
|
28
|
-
|
|
29
|
-
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
|
30
|
-
|
|
31
|
-
Dim fs
|
|
32
|
-
|
|
33
|
-
Set fs =CreateObject("Scripting.FileSystemObject") Dim folder
|
|
34
|
-
|
|
35
|
-
Set folder = fs.GetFolder( DIR )
|
|
36
|
-
|
|
37
|
-
Dim file 'エラーカウンター
|
|
38
|
-
|
|
39
|
-
Dim cnt cnt = 0 For Each file In folder.Files 'WScript.Echo file On Error Resume Next cn.Execute "INSERT INTO [Sheet1$] SELECT * FROM [Excel 16;database=" & file & "].[***$A3:AI4]"
|
|
40
|
-
|
|
41
|
-
If Err.Number = 0 Then 'WScript.Echo "OK"
|
|
42
|
-
|
|
43
|
-
Else cnt = cnt + 1 'WScript.Echo "Error!! 修正して下さい:" & file Dim objExcel
|
|
44
|
-
|
|
45
|
-
Set objExcel = CreateObject("Excel.Application")
|
|
46
|
-
|
|
47
|
-
objExcel.Visible = True
|
|
48
|
-
|
|
49
|
-
objExcel.Workbooks.Open file
|
|
50
|
-
|
|
51
|
-
Set objExcel = Nothing
|
|
52
|
-
|
|
53
|
-
End
|
|
54
|
-
|
|
55
|
-
If Next
|
4
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -14,15 +14,17 @@
|
|
|
14
14
|
|
|
15
15
|
Const DIR = "C:\Temp******\data"
|
|
16
16
|
|
|
17
|
-
Const XLS = "C:\Temp*********.xlsx"
|
|
17
|
+
Const XLS = "C:\Temp*********.xlsx"
|
|
18
|
+
|
|
19
|
+
|
|
18
20
|
|
|
19
21
|
Marge
|
|
20
22
|
|
|
21
|
-
Sub Marge
|
|
23
|
+
Sub Marge
|
|
22
24
|
|
|
23
|
-
Dim cn
|
|
25
|
+
Dim cn
|
|
24
26
|
|
|
25
|
-
Dim rs
|
|
27
|
+
Dim rs
|
|
26
28
|
|
|
27
29
|
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
|
28
30
|
|
3
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -16,7 +16,9 @@
|
|
|
16
16
|
|
|
17
17
|
Const XLS = "C:\Temp*********.xlsx"
|
|
18
18
|
|
|
19
|
+
Marge
|
|
20
|
+
|
|
19
|
-
|
|
21
|
+
Sub Marge
|
|
20
22
|
|
|
21
23
|
Dim cn
|
|
22
24
|
|
2
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -10,6 +10,42 @@
|
|
|
10
10
|
|
|
11
11
|
|
|
12
12
|
|
|
13
|
+
Option Explicit
|
|
13
14
|
|
|
15
|
+
Const DIR = "C:\Temp******\data"
|
|
14
16
|
|
|
17
|
+
Const XLS = "C:\Temp*********.xlsx"
|
|
18
|
+
|
|
19
|
+
Marge Sub Marge
|
|
20
|
+
|
|
21
|
+
Dim cn
|
|
22
|
+
|
|
23
|
+
Dim rs
|
|
24
|
+
|
|
25
|
+
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
|
26
|
+
|
|
27
|
+
Dim fs
|
|
28
|
+
|
|
29
|
+
Set fs =CreateObject("Scripting.FileSystemObject") Dim folder
|
|
30
|
+
|
|
31
|
+
Set folder = fs.GetFolder( DIR )
|
|
32
|
+
|
|
33
|
+
Dim file 'エラーカウンター
|
|
34
|
+
|
|
35
|
+
Dim cnt cnt = 0 For Each file In folder.Files 'WScript.Echo file On Error Resume Next cn.Execute "INSERT INTO [Sheet1$] SELECT * FROM [Excel 16;database=" & file & "].[***$A3:AI4]"
|
|
36
|
+
|
|
37
|
+
If Err.Number = 0 Then 'WScript.Echo "OK"
|
|
38
|
+
|
|
39
|
+
Else cnt = cnt + 1 'WScript.Echo "Error!! 修正して下さい:" & file Dim objExcel
|
|
40
|
+
|
|
41
|
+
Set objExcel = CreateObject("Excel.Application")
|
|
42
|
+
|
|
43
|
+
objExcel.Visible = True
|
|
44
|
+
|
|
45
|
+
objExcel.Workbooks.Open file
|
|
46
|
+
|
|
47
|
+
Set objExcel = Nothing
|
|
48
|
+
|
|
15
|
-
|
|
49
|
+
End
|
|
50
|
+
|
|
51
|
+
If Next
|
1
test
CHANGED
|
File without changes
|
test
CHANGED
|
File without changes
|