質問編集履歴
5
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -1,28 +1,1 @@
|
|
|
1
|
-
windows8.1で動いていたvbsがwindows10で使用できなくなりました。
|
|
2
|
-
|
|
1
|
+
データフォルダの中にある、エクセルが例えば1つであれば、ポップアップは
|
|
3
|
-
Excel 16.0に修正しましたが、動きません。
|
|
4
|
-
|
|
5
|
-
他に修正箇所がわからないのでお教えいただきたくお願いいたします。
|
|
6
|
-
|
|
7
|
-
Option Explicit
|
|
8
|
-
Const DIR = "C:\Temp******\data"
|
|
9
|
-
Const XLS = "C:\Temp*********.xlsx"
|
|
10
|
-
|
|
11
|
-
Marge
|
|
12
|
-
Sub Marge
|
|
13
|
-
Dim cn
|
|
14
|
-
Dim rs
|
|
15
|
-
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
|
16
|
-
Dim fs
|
|
17
|
-
Set fs =CreateObject("Scripting.FileSystemObject") Dim folder
|
|
18
|
-
Set folder = fs.GetFolder( DIR )
|
|
19
|
-
Dim file 'エラーカウンター
|
|
20
|
-
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]"
|
|
21
|
-
If Err.Number = 0 Then 'WScript.Echo "OK"
|
|
22
|
-
Else cnt = cnt + 1 'WScript.Echo "Error!! 修正して下さい:" & file Dim objExcel
|
|
23
|
-
Set objExcel = CreateObject("Excel.Application")
|
|
24
|
-
objExcel.Visible = True
|
|
25
|
-
objExcel.Workbooks.Open file
|
|
26
|
-
Set objExcel = Nothing
|
|
27
|
-
End
|
|
28
|
-
If Next
|
4
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -6,11 +6,12 @@
|
|
|
6
6
|
|
|
7
7
|
Option Explicit
|
|
8
8
|
Const DIR = "C:\Temp******\data"
|
|
9
|
-
Const XLS = "C:\Temp*********.xlsx"
|
|
9
|
+
Const XLS = "C:\Temp*********.xlsx"
|
|
10
|
+
|
|
10
11
|
Marge
|
|
11
|
-
Sub Marge
|
|
12
|
+
Sub Marge
|
|
12
|
-
Dim cn
|
|
13
|
+
Dim cn
|
|
13
|
-
Dim rs
|
|
14
|
+
Dim rs
|
|
14
15
|
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
|
15
16
|
Dim fs
|
|
16
17
|
Set fs =CreateObject("Scripting.FileSystemObject") Dim folder
|
3
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -7,7 +7,8 @@
|
|
|
7
7
|
Option Explicit
|
|
8
8
|
Const DIR = "C:\Temp******\data"
|
|
9
9
|
Const XLS = "C:\Temp*********.xlsx"
|
|
10
|
+
Marge
|
|
10
|
-
|
|
11
|
+
Sub Marge
|
|
11
12
|
Dim cn
|
|
12
13
|
Dim rs
|
|
13
14
|
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
2
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -4,5 +4,23 @@
|
|
|
4
4
|
|
|
5
5
|
他に修正箇所がわからないのでお教えいただきたくお願いいたします。
|
|
6
6
|
|
|
7
|
-
|
|
7
|
+
Option Explicit
|
|
8
|
+
Const DIR = "C:\Temp******\data"
|
|
9
|
+
Const XLS = "C:\Temp*********.xlsx"
|
|
10
|
+
Marge Sub Marge
|
|
11
|
+
Dim cn
|
|
12
|
+
Dim rs
|
|
13
|
+
Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.14.0;Data Source=" & xls & ";Extended Properties=Excel 16.0"
|
|
14
|
+
Dim fs
|
|
15
|
+
Set fs =CreateObject("Scripting.FileSystemObject") Dim folder
|
|
16
|
+
Set folder = fs.GetFolder( DIR )
|
|
17
|
+
Dim file 'エラーカウンター
|
|
18
|
+
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]"
|
|
19
|
+
If Err.Number = 0 Then 'WScript.Echo "OK"
|
|
20
|
+
Else cnt = cnt + 1 'WScript.Echo "Error!! 修正して下さい:" & file Dim objExcel
|
|
21
|
+
Set objExcel = CreateObject("Excel.Application")
|
|
22
|
+
objExcel.Visible = True
|
|
23
|
+
objExcel.Workbooks.Open file
|
|
24
|
+
Set objExcel = Nothing
|
|
8
|
-
|
|
25
|
+
End
|
|
26
|
+
If Next
|
1
title
CHANGED
|
File without changes
|
body
CHANGED
|
File without changes
|