如何使用VBA将所有字形日期字段从m / d / yyyy重新格式化为yyyy-mm-dd？

Question

我正在研究一个自定义的VBA脚本，该脚本可动态收集用户输入的表单数据并将其插入到MySQL数据库中。我的问题是，要将表单字段数据转换为SQL脚本，我必须使用字符串函数；因此，我的所有数据（包括日期）都将作为文本插入。我需要将MySQL数据库将表单收集的所有日期从m / d / yyyy格式转换为yyyy-mm-dd格式，以推断架构并将日期数据加载到DB中而不会出现错误。我需要动态地执行此操作，这意味着无论收集了多少日期字段，该脚本都必须工作。我有：

Private Sub Submit_Button()

Dim doc as Document
Dim control As ContentControl
Dim FormDateField As Date
Dim ReportNumber As String
Dim myValues As String
Dim myFields As String
Dim conn As ADODB.Connection
Dim strSQL As String

Set doc = Application.ActiveDocument
Set conn = New ADODB.Connection
conn.open "DSN=ABCD"

For Each control In doc.ContentControls
  Skip = False
  If Left(control.Range.Text, 5) = "Click" Or Left(control.Range.Text, 6) = "Choose" Then
    Skip = True
  Else:
    myFields = myFields & control.Tag
    myValues = myValues & "'" & control.Range.Text & "'"
  End If

  If Not Skip Then
    myFields = myFields & ", "
    myValues = myValues & ", "
  End If

  Next

myFields = Left(myFields, Len(myFields) - 2)
myValues = Left(myValues, Len(myValues) - 2)

strSQL = "INSERT INTO TABLE_1 ("
strSQL = strSQL & myFields
strSQL = strSQL & ") VALUES (" & myValues
strSQL = strSQL & ")"

conn.Execute strSQL
MsgBox "Form data saved to database!"
conn.Close

End Sub

但是，我的程序崩溃是因为它试图在日期字段中插入一个字符串（实际的最终形式将包含许多日期字段。）我想如果将日期格式更改为MySQL格式，则可以推断出模式？我尝试添加

If IsDate(control.Range.Text) Then
  control.Range.Text = Format(control.Range.Text, "yyyy-mm-dd")
Else FoundOne = False
End If

而且我知道您可以在Excel中执行：

Application.FindFormat.NumberFormat = "m/d/yyyy"
Application.ReplaceFormat = "yyyy-mm-dd"

有什么建议吗？谢谢。

Answer 1

您注意到，Word没有Application.FindFormat或Application.ReplaceFormat，但是如果您知道格式为m / d / y，则应该可以这样做：

myValues = myValues & "'" & ymd(control.Range.Text) & "'"


Function ymd(s as String) As String
Dim v As Variant
v = VBA.split(s, "/")
ymd = Right("0000" & v(2),4) & "-" & Right("00" & v(0),2) & "-" & Right("00" & v(1),2)
End Function

其他所有内容（例如，将逗号添加到日期列表中的方式）看起来都不错，但我尚未测试。

Answer 2

假设所有日期都在日期选择器内容控件中，则可以使用：

Private Sub Submit_Button()
Dim CCtrl As ContentControl, bSv As Boolean, DtFmt As String
Dim myFields As String, myValues As String, strSQL As String
With ActiveDocument
  bSv = .Saved
  For Each CCtrl In .ContentControls
    With CCtrl
      If .ShowingPlaceholderText = False Then
        Select Case .Type
          Case wdContentControlDate
            DtFmt = .DateDisplayFormat
            .DateDisplayFormat = "YYYY-MM-DD"
            myFields = myFields & .Tag & ", "
            myValues = myValues & "'" & .Range.Text & "', "
            .DateDisplayFormat = DtFmt
          Case wdContentControlRichText, wdContentControlText, wdContentControlDropdownList, wdContentControlComboBox
            myFields = myFields & .Tag & ", "
            myValues = myValues & "'" & .Range.Text & "', "
          Case Else
        End Select
      End If
    End With
  Next
  .Saved = bSv
End With
If myFields <> "" Then
  myFields = Left(myFields, Len(myFields) - 2)
  myValues = Left(myValues, Len(myValues) - 2)
  strSQL = "INSERT INTO TABLE_1 (" & myFields & ") VALUES (" & myValues & ")"
  Dim Conn As New ADODB.Connection
  With Conn
    .Open "DSN=ABCD": .Execute strSQL: .Close
  End With
  Set Conn = Nothing
  MsgBox "Form data saved to database", vbInformation
Else
  MsgBox "No form data found", vbExclamation
End If
End Sub