所以,在下面你看到我的代码,它是我在这里找到的代码的一个修改版本,现在无法找到源代码......
我得到的错误是运行时1004,我无法弄清楚它为什么不起作用。
如果我使用strVal3之前的变量(参见.CommandText行),它就可以工作。
非常感谢任何帮助/建议。
Sub valandinai()
Dim strVal1 As String
Dim strVal2 As String
Dim strVal3 As String
Dim strVal4 As String
Dim strVal5 As String
Dim strSQL As String
'assume the list of values you want in the IN() statement in the sql is held in cells A1:A100 of sheet "MyValues" (obviously amend as appropriate)
'create the delimited list of values from sheet myValues and range A1:A100:
strVal1 = "('" & Join(Application.Transpose(Sheets("Sheet4").Range("A1:A999").Value), "','") & "')"
strVal2 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A1000:A1999").Value), "','") & "')"
strVal3 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A2000:A2500").Value), "','") & "')"
strVal4 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A2501:A2999").Value), "','") & "')"
strVal5 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A3000:A3500").Value), "','") & "')"
strVal6 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A3000:A3500").Value), "','") & "')"
strVal7 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A3501:A3999").Value), "','") & "')"
strVal8 = vbNewLine & "or kl.klnt_im_kodas in ('" & Join(Application.Transpose(Sheets("Sheet4").Range("A4000:A4411").Value), "','") & "')"
'============ IMPORTANT =============================
'note that if you had a horizontal list of values, you need to use Application.Transpose twice:
'strVal = "'" & Join(Application.Transpose(Application.Transpose(Sheets("MyValues").Range("A1:A100").Value)), "','") & "'"
ThisWorkbook.Sheets("Sheet4").Range("h1").Value = strVal1
ThisWorkbook.Sheets("Sheet4").Range("h2").Value = strVal2
ThisWorkbook.Sheets("Sheet4").Range("h3").Value = strVal3
ThisWorkbook.Sheets("Sheet4").Range("h4").Value = strVal4
ThisWorkbook.Sheets("Sheet4").Range("h5").Value = strVal5
'this is your current SQL statement as a string and we insert the values at the 'strVal' placeholder:
strSQL = "Select kl.klnt_im_kodas, Kl.Klnt_Pavadinimas, Su.Str_Id, Su.Str_Numeris," & vbNewLine & _
"--Ob.Obj_Id," & vbNewLine & _
"ob.obj_nr," & vbNewLine & _
"ob.obj_adresas," & vbNewLine & _
"Trim(To_Char(Vs.Ovs_ltu_Laikas, 'YYYY mm')) As menuo ," & vbNewLine & _
"Trim(To_Char(Vs.Ovs_ltu_Laikas, 'YYYY mm dd'))As Laikas ," & vbNewLine & _
"To_Char(Vs.Ovs_ltu_Laikas, 'D') As Sav_diena," & vbNewLine & _
"Trim(To_Char(Vs.Ovs_ltu_Laikas, 'hh24:mi'))As Valanda," & vbNewLine & _
"Vs.ovs_kiekis" & vbNewLine & _
"From Eta_Obj_Val_Suvart Vs" & vbNewLine & _
"Left Join Eta_Objektai Ob On Vs.Ovs_Obj_Id=Ob.Obj_Id" & vbNewLine & _
"Left Join Eta_Sutartys Su On Ob.Obj_Str_Id=Su.Str_Id" & vbNewLine & _
"left join eta_klientai kl on su.str_klnt_id=kl.klnt_id" & vbNewLine & _
"Where 1 = 1" & vbNewLine & _
"--And Vs.Ovs_Laikas>='2015.10.01'" & vbNewLine & _
"And Vs.Ovs_ltu_Laikas>=Add_Months(Trunc(Sysdate,'MM'),-12)" & vbNewLine & _
"and kl.klnt_im_kodas in" & vbNewLine
ThisWorkbook.Sheets("Sheet1").Range("A2").Value = strVal1
ThisWorkbook.Sheets("Sheet1").Range("A1").Value = strSQL
' Now use the strSQL in connection info (do NOT use the Array function to assign it though):
With ActiveWorkbook.Connections("Connection").ODBCConnection
.BackgroundQuery = True
.CommandText = strSQL & strVal1 & strVal2 & strVal3 & strVal4 & strVal5
.CommandType = xlCmdSql
.Connection = "connection string"
.RefreshOnFileOpen = False
.SavePassword = True
.SourceConnectionFile = ""
'.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
ActiveWorkbook.Connections("Connection").Delete
With ActiveWorkbook.Connections("Connection1")
.Name = "Connection"
.Description = ""
End With
'ActiveWorkbook.Connections("Connection").Refresh
MsgBox "Done", vbInformation, "Done"
End Sub