Board logo

标题: [转贴] VBScript脚本读取Access数据库 [打印本页]

作者: find    时间: 2012-2-16 13:05     标题: VBScript脚本读取Access数据库

  1. Option Explicit
  2. Dim arrTables( ), i, idxTables, intValidArgs
  3. Dim blnContent, blnFieldNames
  4. Dim objConn, objFSO, objRS, objSchema
  5. Dim strConnect, strHeader, strOutput
  6. Dim strFile, strResult, strSQL, strTable
  7. Const adSchemaTables = 20
  8. ' Check command line arguments
  9. With WScript.Arguments
  10. If .Unnamed.Count = 1 Then
  11. strFile = .Unnamed(0)
  12. Else
  13. Syntax
  14. End If
  15. blnFieldNames = True
  16. blnContent = True
  17. If .Named.Count > 0 Then
  18. intValidArgs = 0
  19. If .Named.Exists( "T" ) Then
  20. blnFieldNames = False
  21. blnContent = False
  22. intValidArgs = intValidArgs + 1
  23. End If
  24. If .Named.Exists( "TF" ) Then
  25. blnContent = False
  26. intValidArgs = intValidArgs + 1
  27. End If
  28. If intValidArgs <> .Named.Count Then Syntax
  29. End If
  30. End With
  31. ' Check if the specified database file exists
  32. Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  33. If Not objFSO.FileExists( strFile ) Then Syntax
  34. Set objFSO = Nothing
  35. ' Connect to the MS-Access database
  36. Set objConn = CreateObject( "ADODB.Connection" )
  37. strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile
  38. objConn.Open strConnect
  39. ' Search for user tables and list them in an array
  40. Set objSchema = objConn.OpenSchema( adSchemaTables )
  41. idxTables = -1
  42. Do While Not objSchema.EOF
  43. If objSchema.Fields.Item(3).Value = "TABLE" Then
  44. idxTables = idxTables + 1
  45. ReDim Preserve arrTables( idxTables )
  46. arrTables( idxTables ) = objSchema.Fields.Item(2).Value
  47. End If
  48. objSchema.MoveNext
  49. Loop
  50. ' List all tables, their column names and their contents
  51. For Each strTable In arrTables
  52. strSQL = "Select * From " & strTable
  53. Set objRS = objConn.Execute( strSQL )
  54. If IsObject( objRS ) Then
  55. ' Display the current table's name
  56. If blnContent Then
  57. WScript.Echo """Table: " & strTable & """"
  58. Else
  59. WScript.Echo """" & strTable & """"
  60. End If
  61. If blnFieldNames Then
  62. strOutput = ""
  63. Do While Not objRS.EOF
  64. ' Create a header line with the column names and data types
  65. strHeader = ""
  66. For i = 0 To objRS.Fields.Count - 1
  67. strHeader = strHeader & ",""[" _
  68. & GetDataTypeDesc( objRS.Fields.Item(i).Type ) & "] " _
  69. & objRS.Fields.Item(i).Name & """"
  70. Next
  71. strHeader = Mid( strHeader, 2 )
  72. If blnContent Then
  73. ' List the fields of the current record in comma delimited format
  74. strResult = ""
  75. For i = 0 To objRS.Fields.Count - 1
  76. strResult = strResult & ",""" & objRS.Fields.Item(i).Value & """"
  77. Next
  78. ' Add the current record to the output string
  79. strOutput = strOutput & Mid( strResult, 2 ) & vbCrLf
  80. End If
  81. ' Next record
  82. objRS.MoveNext
  83. Loop
  84. ' List the results for the current table
  85. WScript.Echo strHeader & vbCrLf & strOutput & vbCrLf
  86. End If
  87. End If
  88. Next
  89. objRS.Close
  90. objSchema.Close
  91. objConn.Close
  92. Set objRS = Nothing
  93. Set objSchema = Nothing
  94. Set objConn = Nothing
  95. Function GetDataTypeDesc( myTypeNum )
  96. Dim arrTypes( 8192 ), i
  97. For i = 0 To UBound( arrTypes )
  98. arrTypes( i ) = "????"
  99. Next
  100. arrTypes(0) = "Empty"
  101. arrTypes(2) = "SmallInt"
  102. arrTypes(3) = "Integer"
  103. arrTypes(4) = "Single"
  104. arrTypes(5) = "Double"
  105. arrTypes(6) = "Currency"
  106. arrTypes(7) = "Date"
  107. arrTypes(8) = "BSTR"
  108. arrTypes(9) = "IDispatch"
  109. arrTypes(10) = "Error"
  110. arrTypes(11) = "Boolean"
  111. arrTypes(12) = "Variant"
  112. arrTypes(13) = "IUnknown"
  113. arrTypes(14) = "Decimal"
  114. arrTypes(16) = "TinyInt"
  115. arrTypes(17) = "UnsignedTinyInt"
  116. arrTypes(18) = "UnsignedSmallInt"
  117. arrTypes(19) = "UnsignedInt"
  118. arrTypes(20) = "BigInt"
  119. arrTypes(21) = "UnsignedBigInt"
  120. arrTypes(64) = "FileTime"
  121. arrTypes(72) = "GUID"
  122. arrTypes(128) = "Binary"
  123. arrTypes(129) = "Char"
  124. arrTypes(130) = "WChar"
  125. arrTypes(131) = "Numeric"
  126. arrTypes(132) = "UserDefined"
  127. arrTypes(133) = "DBDate"
  128. arrTypes(134) = "DBTime"
  129. arrTypes(135) = "DBTimeStamp"
  130. arrTypes(136) = "Chapter"
  131. arrTypes(138) = "PropVariant"
  132. arrTypes(139) = "VarNumeric"
  133. arrTypes(200) = "VarChar"
  134. arrTypes(201) = "LongVarChar"
  135. arrTypes(202) = "VarWChar"
  136. arrTypes(203) = "LongVarWChar"
  137. arrTypes(204) = "VarBinary"
  138. arrTypes(205) = "LongVarBinary"
  139. arrTypes(8192) = "Array"
  140. GetDataTypeDesc = arrTypes( myTypeNum )
  141. End Function
  142. Sub Syntax
  143. Dim strMsg
  144. strMsg = strMsg & vbCrLf _
  145. & "AccessRd.vbs, Version 1.01" & vbCrLf _
  146. & "Display MS Access database (user) tables and, optionally, their contents" _
  147. & vbCrLf & vbCrLf _
  148. & "Usage: CSCRIPT //NOLOGO ACCESSRD.VBS access_db_file [ /T | /TF ]" _
  149. & vbCrLf & vbCrLf _
  150. & "Where: ""access_db_file"" is an MS-Access database file" & vbCrLf _
  151. & " /T list table names only" & vbCrLf _
  152. & " /TF list table and field names only" & vbCrLf _
  153. & " (default is list tables, field names AND contents)" _
  154. & vbCrLf & vbCrLf _
  155. & "Written by Rob van der Woude" & vbCrLf _
  156. & "http://www.robvanderwoude.com"
  157. WScript.Echo strMsg
  158. WScript.Quit(1)
  159. End Sub
复制代码


转自:http://www.robvanderwoude.com
作者: powerbat    时间: 2012-2-16 15:24

何必舍近求远呢?
http://www.bathome.net/thread-14775-1-1.html
http://www.bathome.net/thread-14827-1-1.html




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2