提示词分享 加弹框加循环（提示的框框如何设计）
优化上面的vbs代码。 excelFile = "6月份生产技术员日报表.xlsx" 这个代码不要写死，用弹框形式。由用户选择指定文件夹。然后遍历该文件夹下的所有xls或者xlsx文件。 其他逻辑不变
' Database connection details
server = "192.168.xxx.xxxxx"
database = "UFDATA_00x_xxxxxx"
username = "sa"
password = "1xxxxe"
' Excel file path
excelFile = "6月份生产技术员日报表.xlsx"
' Create Excel and ADODB objects
Set excelApp = CreateObject("Excel.Application")
Set workbook = excelApp.Workbooks.Open(CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(excelFile))
Set sheet = workbook.Sheets("生产明细")
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
' Open database connection
connStr = "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";User ID=" & username & ";Password=" & password & ";"
conn.Open connStr
' Delete data from 2023 based on the "发生日期" field
deleteSQL = "DELETE FROM 生产明细T "
conn.Execute deleteSQL
If Err.Number <> 0 Then
MsgBox "Error executing SQL: " & deleteSQL & vbCrLf & "Error: " & Err.Description
Err.Clear
End If
' Get the header row to construct the insert query
headerRow = ""
col = 1
For Each cell In sheet.Rows(2).Cells
If cell.Value = "" Then Exit For
If col = 12 Then Exit For
If headerRow <> "" Then headerRow = headerRow & ", "
headerRow = headerRow & "[" & ReplaceColumnNames(cell.Value) & "]"
col = col + 1
Next
CreateObject("wscript.shell").popup headerRow, , "--温馨提示--"
' Insert data into the database
row = 3
'msgbox sheet.Cells(row, 1).Value
Do While sheet.Cells(row, 1).Value <> ""
valuesRow = ""
col = 1
For Each cell In sheet.Rows(row).Cells
'If cell.Value = "" Then Exit For
If col = 12 Then Exit For
If valuesRow <> "" Then valuesRow = valuesRow & ", "
valuesRow = valuesRow & "'" & Replace(cell.Value, "'", "''") & "'"
col = col + 1
Next
sql = "INSERT INTO 生产明细T (" & headerRow & ") VALUES (" & valuesRow & ")"
'msgbox sql
CreateObject("wscript.shell").popup sql, , "--温馨提示1--"
conn.Execute sql
'msgbox 222
If Err.Number <> 0 Then
MsgBox "Error executing SQL: " & sql & vbCrLf & "Error: " & Err.Description
Err.Clear
End If
row = row + 1
Loop
' Clean up
workbook.Close False
excelApp.Quit
conn.Close
Set rs = Nothing
Set conn = Nothing
Set sheet = Nothing
Set workbook = Nothing
Set excelApp = Nothing
Function ReplaceColumnNames(columnName)
If InStr(columnName, "国内/国际") > 0 Then
ReplaceColumnNames = "国内_国际"
ElseIf InStr(columnName, "公司名称 ") > 0 Then
ReplaceColumnNames = "公司名称"
ElseIf InStr(columnName, "实际出发地（司机点击开始的位置）") > 0 Then
ReplaceColumnNames = "实际出发地"
ElseIf InStr(columnName, "实际目的地（司机点击结束的位置）") > 0 Then
ReplaceColumnNames = "实际目的地"
Else
ReplaceColumnNames = columnName
End If
End Function
