vbs实现wincc或mysql数据导出成csv

工作要求，需要编写vbs实现将wincc数据导出，估计以后也没机会再接触这门古董语言了，所以就记录一下。
因为wincc用得太少了，测试中会使用mysql代替。

业务逻辑

1. 读取sql.txt文件，文件中每一行的格式为 id:select语句。
2. 连接数据库，按行遍历执行查询，查询到的结果输出到指定文件夹下，得到以id命名的csv文件。
3. 将执行过程、花费时间记录起来。

操作过程

1. 准备sql文本文件
2. 将代码复制到文本编辑器中，修改数据库连接参数、sql文本文件位置，输出文件夹位置，日志文件位置等
3. 修改代码文件后缀为vbs
4. 直接执行该文件即可
5. 得到csv文件
   

代码

Sub Main

	set fs =createobject("scripting.filesystemobject")
	set sqlTxt=fs.opentextfile("C:\Users\15588\Desktop\vscode\sql.txt",1,false)
	do while sqlTxt.atendofstream<>true
		StartTime=Timer
		queryStr=sqlTxt.readline
		logs("开始执行: " & queryStr & "------------------------------")
		queryStrArray=split(queryStr,":")
		id=queryStrArray(0)
		sSql=queryStrArray(1)
		Dim db
		Set db = New MySQLDB
		db.Connect "数据库名", "root", "数据库密码", "ip", 3306
		''' Set db = New WinccDB
		''' db.Connect "WinCCOLEDBProvider.1", "CC_wincctes_18_07_11_22_23_06R", "WINCC-PC\WinCC"

		If Err Then
			MsgBox Err.Description
			db.UnConnect
			Exit Sub
		End If

		Call queryToCsv(id, db.oConn,sSql,"C:\Users\15588\Desktop\vscode\halodb\" & id & ".csv")
		
		If Err Then
			MsgBox Err.Description
			db.UnConnect
			Exit Sub
		End If
		db.UnConnect
		Set db = Nothing

		EndTime=Timer
		Timelt=EndTime-StartTime
		logs("结束执行,耗时（秒）:"& Timelt)
	
	loop

	
End Sub

Call Main

Class WinccDB
	
	'''Current Error Code:
	'''	- 1
	'''	- 2
	'''	- 3
	Public oConn
	Private oRecSet
	
	
	Private Sub Class_Initialize
	End Sub
	
	
	Private Sub Class_Terminate
		UnConnect
		Set dictErrDef = Nothing
		'''logs( "Clean works complete.")
	End Sub
	
	
	'''' Public Methods ''''
	Public Sub Connect(provider,cataloge,ds)
		On Error Resume Next
		Err.Clear
		
		Dim sConnStr
		
		'''Create CONNECTION STRING
		sConnStr ="Provider=" & provider & ";Catalog=" & cataloge & ";Data Source=" & ds
		'''logs( "sConnStr:" & sConnStr)
		'''Create CONNECTION
		Set oConn = CreateObject("ADODB.Connection")
		oConn.ConnectionString = sConnStr
		oConn.CursorLocation = 3
		oConn.Open
		If Err Then
			MsgBox "Connection error"
			MsgBox Err.Source
			MsgBox Err.Description
			Err.Raise vbObjectError + 1
			Exit Sub
		End If
		If oConn.State = 0 Then
			MsgBox "oConn.State = 0 "
			Err.Raise vbObjectError + 1
			Exit Sub
		End If
		'''MsgBox "Connection created."
	End Sub
	
	Public Sub UnConnect()
		If oConn Is Nothing Then
			Exit Sub
		End If
		oConn.Close
		Set oConn = Nothing
	End Sub
	
	
End Class

Class MySQLDB
	
	'''Current Error Code:
	'''	- 1
	'''	- 2
	'''	- 3
	Public oConn
	Private oRecSet
	
	
	Private Sub Class_Initialize
	End Sub
	
	
	Private Sub Class_Terminate
		UnConnect
		Set dictErrDef = Nothing
		'''logs( "Clean works complete.")
	End Sub
	
	
	'''' Public Methods ''''
	Public Sub Connect(db,uid,pwd,host,port)
		On Error Resume Next
		Err.Clear
		
		Dim sConnStr
		
		'''Create CONNECTION STRING
		sConnStr = "DRIVER={MySQL ODBC 8.0 Unicode Driver};"
		'sConnStr = "DRIVER={MySQL ODBC 5.2 ANSI Driver};"
		sConnStr = sConnStr & "Database=" & db & ";"
		sConnStr = sConnStr & "User=" & uid & ";"
		sConnStr = sConnStr & "Password=" & pwd & ";"
		sConnStr = sConnStr & "Server=" & host & ";"
		sConnStr = sConnStr & "Port=" & port & ";"
		sConnStr = sConnStr & "Option=3;"
		
		'''Create CONNECTION
		Set oConn = CreateObject("ADODB.Connection")
		oConn.Open sConnStr
		If Err Or oConn.State = 0 Then
			MsgBox "oConn.State = 0 "
			Err.Raise vbObjectError + 1
			Exit Sub
		End If
		'''MsgBox "Connection created."
	End Sub
	
	Public Sub UnConnect()
		If oConn Is Nothing Then
			Exit Sub
		End If
		oConn.Close
		Set oConn = Nothing
	End Sub
	
	
End Class


Public Function queryToCsv(id,oConn,sql,path)
	On Error Resume Next
	Err.Clear
	
	'''CREATE RECORDSET
	Set oRecSet = CreateObject("ADODB.Recordset")
	oRecSet.CursorLocation = 3
	oRecSet.Open sql, oConn
	If Err Then
		MsgBox "query error"
		MsgBox Err.Source
		MsgBox Err.Description
		Exit Function
	End If
	logs( "oRecSet.RecordCount:" & oRecSet.RecordCount)
	Call RecordSet2Csv(id,oRecSet,path)
End Function
Public Function RecordSet2Csv(id,rs,path)
	Dim field
	Dim tmpStr
	Dim c
	c = 1
	Set outFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(path)
	tmpStr=CsvValue_("id") & ","
	For Each field In rs.Fields
		If field.Name = "" Then
			tmpStr=tmpStr &  CsvValue_("(computed" & c & ")") & ","
			c = c + 1
		Else
			tmpStr=tmpStr &  CsvValue_(field.Name) & ","
		End If
	Next
	outFile.WriteLine   RTrimOne_(tmpStr)
    c = 1
	Do While Not rs.EOF
		'''If c=65535 Then
		'''    MsgBox "记录数超过65535！请缩小导出时间范围！"
		'''    Exit Do
		'''End If
		tmpStr =  CsvValue_(id) & ","
		For Each field In rs.Fields
			'''tmpStr=tmpStr &   CsvValue_(field.Value) & ","
			tmpStr=tmpStr &   field.Value & ","
		Next
		outFile.WriteLine   RTrimOne_(tmpStr)
		rs.MoveNext
        c = c+1
	Loop
End Function

Private Function CsvValue_(val)
	If IsNull(val) Then
		CsvValue_ = ""
	Else
		CsvValue_ = """" & Replace(val, """", """""") & """"
	End If
End Function

Private Function RTrimOne_(str)
	RTrimOne_ = Left(str, Len(str) - 1)
End Function

Private Function logs(logdetail)
	
	FilePath = "C:\Users\15588\Desktop\vscode\mysql2csv.log"  'LOG文件的路径
	LOGDetail = logdetail  'LOG的内容
	
	Set fso = CreateObject("scripting.FileSystemObject")
	
	'判断LOG文件是否存在,如不存在,则按指定路径新建
	
	If fso.FileExists(FilePath) = False  Then
		
		Set LOGFile = fso.CreateTextFile(FilePath, True)
		
		LOGFile.Close
		
	End If
	
	
	Set LOGFile = fso.OpenTextFile(FilePath, 8, True)  '8为追加
	
	LOGFile.WriteLine   Cstr(Now) & " : " & LOGDetail
	
	LOGFile.Close
	
End Function

Q.E.D.