I am tying to update an existing connection in a spreadsheet with a modifiable script.
Basically, I want the use to be able to put in a list of Account References, push a button, and Excel spits out the SQL output where those Account References match what we have one system.
I've managed to collate all of the script into one cell (F1 on my Workings tab), so that's all fine, and I've added the preliminary connection (and called it "CustomerContactDetails").
I have enabled the Microsoft ActiveX Data Objects 6.1 Library as well.
My VBA script is:
Sub UpdateScript()
Dim Script As String
SQLScript = Worksheets("Workings").Range("F1").Value
ActiveWorkbook.Connections("CustomerContactDetails").OLEDBConnection.ConnectionString = SQLScript
ActiveWorkbook.Connections("CustomerContactDetails").Refresh
End Sub
I get the error on the fourth line down (ActiveWorkbook.Connections("CustomerContactDetails").OLEDBConnection.ConnectionString = SQLScript):
Run-time error '9';
Subscript out of range
Does anyone know how to help with this please? It feels like I'm not that far way, and I'm not trying to do anything too complicated. I just can't seem to get it to work!
Try something like this and see what output you get
Sub UpdateScript()
Dim Script As String
Dim conn as WorkbookConnection
For Each conn in ActiveWorkbook.Connections
Debug.Print conn.Name
If conn.Name = "CustomerContactDetails" Then
SQLScript = Worksheets("Workings").Range("F1").Value
conn.OLEDBConnection.ConnectionString = SQLScript
conn.OLEDBConnection.Refresh
End If
Next conn
End Sub
EDIT: looks like what you have is a WorkbookQuery
I created one (to an Oracle DB) and you can access and revise it something like this:
Sub Tester()
Dim q As WorkbookQuery, lo As ListObject
Set lo = ActiveSheet.ListObjects("Query1")
Debug.Print ActiveWorkbook.Queries.Count
Set q = ActiveWorkbook.Queries("Query1")
Debug.Print q.Formula
'revise query
q.Formula = "let" & vbCrLf & _
" Source = Oracle.Database(""BLAH"", [HierarchicalNavigation=true," & _
"Query=""select * from table1""])" & _
vbCrLf & "in" & vbCrLf & "Source"
lo.Refresh 'I got a popup "do you want to run this?" here...
End Sub
Note it's nearly always useful to try recording a macro while creating the type of object you're having trouble modifying - that will point you to the syntax you need.
Related
This one has me really stymied and I suspect it because I am now too "close" to the problem. I am converting a VB.NET routine into a VBA routine. Here is the VB.NET code that works as expected.`
Dim rows() As Object
BOM.GetRows(rows)
Dim row As IEdmBomCell
For Each row In rows
If IsNothing(row) Then Exit For
Dim rowString As String = row.GetTreeLevel.ToString & vbTab
Dim varVal As String = ""
For Each column As EdmBomColumn In columns
row.GetVar(column.mlVariableID, column.meType, varVal, Nothing, Nothing, Nothing)
If IsNothing(varVal) Then varVal = ""
rowString = rowString & varVal & vbTab
Next
'-----------------------------WRITE THE ROW TO THE FILE
sw.writeline(rowString)
Next`
The VBA code I have looks like this:
Dim varVal As String
Dim rows() As Variant
Dim row As IEdmBomCell
Dim rowstring As String
Call BOM.GetRows(rows)
For p = 0 To UBound(rows)
Set row = rows(p)
If IsEmpty(row) Then Exit For
rowstring = row.GetTreeLevel & vbTab
varVal = ""
For i = 0 To UBound(columns)
column = columns(i)
Call row.GetVar(column.mlColumnID, column.meType, varVal, Nothing, "", True)
rowstring = rowstring & varVal & vbTab
Debug.Print rowstring
Next
'-----------------------------WRITE THE ROW TO THE FILE
sw.writeline (rowstring)
Next
Where I am getting the failure is line Call row.GetVar(column.mlColumnID, column.meType, varVal, Nothing, "", True).
The varVal variable never returns a value, yet the code is stepping through each column data set.
The VBA watch window for all the variables being worked on.
I would like to place the blame on the row.GetVar call being broken, but the .NET code works just fine (on the same machine as the VBA). I just must have a bad assignment somewhere. Again, the code does not fail to run or generate any errors it just never creates the output expected, which looks like this:
Expected Output:
VS. this is this result:
Results of current code:
A bit late to the party but I ran into that issue as well. I've got it working in VBA using a Variant instead of a String variable.
So instead of
Dim varVal As String
try
Dim varVal As Variant
After a bit more digging around the API documentation, I am now fairly confident that the problem is in fact VBA itself.
This information has been in the SolidWorks API documentation for a few versions now. It seems they recommend against using VBA in SolidWorks API applications, and confirm that using VBA may result in unexpected behavior.
I already linked this in my comment, but for completeness sake, here is the first place in the release notes they confirm VBA (VB6) is not supported.
I've had issues with using the PDM API from VBA before and what I needed to do was create a COM wrapper to expose what I needed.
I am getting a type mismatch with the following syntax in my Access VBA. I am trying to update my table named "Billing" by seeing if any records have a date that looks at a string value in my "Certs" table like "2012-07-01" corresponding to my form's billYear textbox e.g. 2012 and my billMonth textbox e.g. 07. Is there a better way to write the VBA or see an error - many thanks:
Dim sRecert As String
Dim byear As Integer
Dim bmonth As Integer
byear = Me.billYear
bmonth = Me.billMonth
sRecert = "Update Billing set recertifying = -1 where (select certificationExpireDate from certs where Left((certificationExpireDate),4) = " & byear
& " and Mid((certificationExpireDate),6,2) = " & bmonth & ")"
DoCmd.RunSQL sRecert
I may not have explained it well. I created a real Query called from my form:
DoCmd.OpenQuery "updateRecert"
I set up my SQL below as a test on a real date I’m working with. It is in SQL Server (ODBC linked)
My dbo_certs table and my dbo_billing table share only one joinable field peopleID:
UPDATE dbo_Billing AS a INNER JOIN dbo_certs AS b ON a.peopleid = b.peopleid
SET a.recertifying = -1
WHERE b.certificationExpireDate = '2015-08-31 00:00:00.000';
The above gave a data mismatch error.
My bottom line is I have two text boxes on my form to pass in data preferably into my VBA code:
billMonth which in this case is 8 because it is an integer so that is
a problem
billYear is 2015
so I need to update my dbo_billing table’s ‘recertifying’ field with -1 if the dbo_cert’s field ‘certificationExpireDate’ is '2015-08-31 00:00:00.000' but only if that can be gotten from the form.
Is there a better way to write the VBA or see an Error?
Yes. You need Error Handling
I don't think the issue is in the code, I think it's in the SQL.
To troubleshoot your code, wrap it in an good error handler.
Public Sub MyRoutine()
On Error GoTo EH
'put your code here
GoTo FINISH
EH:
With Err
MsgBox "Error" & vbTab & .Number & vbCrLf _
& "Source" & vbTab & .Source & vbCrLf & vbCrLf _
& .Description
End With
'for use during debugging
Debug.Assert 0
GoTo FINISH
Resume
FINISH:
'any cleanup code here
End Sub
When the msgbox shows the error, make note of the Source. This should help you determine where the error comes from.
The lines following 'for use during debugging are helpful. Here's how to use them:
execution will stop on the Debug.Assert 0 line
drag the yellow arrow (which determines which line to run next) to the Resume line
hit {F8} on the keyboard (or use the menu Debug > Step Into)
This will go to the line where the error occurred. In your case, it will probably be the last line of your code.
Error in SQL... but!! Are you sure that certificationExpireDate is string and all the time equal to yyyy-mm-dd pattern?? It's dangerouse to have relation with "not certain" key like you have. I think this is not a good db design.
But, after all, for your case:
VBA:
sRecert = "UPDATE Billing a inner join certs b " & _
"on format(a.imaginary_date_field, """yyyy-mm-dd""") = b.certificationExpireDate " & _
"set a.recertifying = -1 " & _
"where CInt(Left((b.certificationExpireDate),4)) = " & byear & " and CInt(Mid((b.certificationExpireDate),6,2)) = " & bmonth
QueryDef:
PARAMETERS Forms!your_form!byear Short, Forms!your_form!bmonth Short;
UPDATE Billing a inner join certs b
on format(a.imaginary_date_field, "yyyy-mm-dd") = b.certificationExpireDate
set a.recertifying = -1
where CInt(Left((b.certificationExpireDate),4)) = Forms!your_form!byear and CInt(Mid((b.certificationExpireDate),6,2)) = Forms!your_form!bmonth
UPDATED
mismatch error
You get error probable because you have date/time field, not a string. Date in MS Access queries write with # symbol. WHERE b.certificationExpireDate = #2015-08-31 00:00:00.000#;
In your case:
PARAMETERS Forms!your_form!byear Short, Forms!your_form!bmonth Short;
UPDATE dbo_Billing AS a INNER JOIN dbo_certs AS b ON a.peopleid = b.peopleid
SET a.recertifying = -1
WHERE year(b.certificationExpireDate) = Forms!your_form!byear and Month(b.certificationExpireDate) = Forms!your_form!bmonth;
For more info follow this link
I have a workbook with a very large amount of named ranges (well over 200). I really need a way to work quickly and easily with all of the named ranges so I can then work with / populate them using VBA.
My solution up until now has been to have code inside a bunch of get properties in my public NamedRanges module, to set the property equal to the named range, like so:
Public Property Get LotNumber49() As range
Set LotNumber49 = Common.GetRange(Strings.LotNumber49)
End Property
Where Strings.LotNumber49 is a property which contains the name of the named range as recorded in the workbook, and Common.GetRange is a method that returns a new instance of the desired range object.
While this solution works well (I can now access an instance of that named range by calling NamedRanges.LotNumber49) It is definitely time consuming and tedious to type up the property in the Strings class and another property in the NamedRanges class.
Is there a better way to accomplish this quick referencing of named ranges that anyone can think of? Perhaps iterating over the collection returned by the Workbook.Names property?
Thank you all, I have this workbook to work on as well as four others, which means a whole lot of named ranges!
Get Named Range by String
Why not a simple procedure like so:
Function GetNR(namedRange as String) as Range
Set GetNR = ActiveWorkbook.Names(namedRange).RefersToRange
End Function
Then simply get the named range like so:
Sub Example()
Debug.Print GetNR("NAME").Value
End Sub
Named Range Suggestion in VBA Project
Alternatively if you want the names to popup in your VBA project you need to redefine the Constants in the Strings class. Try this procedure:
Sub GetAllNames()
Dim res As String, n As Name
For Each n In ActiveWorkbook.Names
If InStr(n.Name, "!") = 0 Then res = res & "Const " & n.Name & "=""" & n.Name & """" & vbNewLine
Next n
Dim fFile As Long
fFile = FreeFile
Open "out.txt" For Output As #fFile
Print #fFile, res
Close #fFile
End Sub
You need to repeat this occasionally when modifying the named ranges:
Run the GetAllNames procedure
Open the out.txt file
Copy the outputs to your Strings class or whatever
Now to get a named range use your Common.GetRange method along with your Strings name or simply use the approach above to generate also the Getter code like so:
Sub GetAllGetters()
Dim res As String, n As Name
For Each n In ActiveWorkbook.Names
If InStr(n.Name, "!") = 0 Then res = res & "Public Property Get " & n.Name & "() As range" & vbNewLine & "Set " & n.Name & " = Common.GetRange(Strings." & n.Name & ")" & vbNewLine & "End Property"
Next n
Dim fFile As Long
fFile = FreeFile
Open "outGetters.txt" For Output As #fFile
Print #fFile, res
Close #fFile
End Sub
This has probably been answered before, but in looking, I could not find an answer that suited my situation. I am coding an Access 2003 form button to run an If/Then and do some commands based on that statement when clicked. However I am getting the 'Object Required' error on every click. I am still relatively new to VBA code, so please be gentle.
Here is the code:
Private Sub Button_Click()
On Error GoTo Err_Button_Click
Dim Db As Object
Set Db = CurrentDb
Dim waveset As DAO.Recordset
Set waveset = Db.OpenRecordset("SELECT countervalue FROM dbo_tblSettings")
Dim orderfile As String
orderfile = "\\serverfolder\serverfile.csv"
If Value.waveset > 0 Then
MsgBox "Orders Already Imported; Please Proceed to Next Step", vbOKOnly, "Step Complete"
GoTo Exit_Button_Click
ElseIf Value.waveset = 0 Then
DoCmd.RunSQL "DELETE FROM dbo_tblOrders", True
DoCmd.TransferText acImportDelim, , "dbo_tblOrders", orderfile, True
DoCmd.RunSQL "UPDATE dbo_tblOrders INNER JOIN dbo_MainOrderTable ON dbo_tblOrders.[channel-order-id]=dbo_MainOrderTable.[order-id] " _
& "SET dbo_MainOrderTable.[order-id] = dbo_tblOrders.[order-id], dbo_MainOrderTable.[channel-order-id] = dbo_tblOrders.[channel-order-id], " _
& "dbo_MainOrderTable.[Order-Source] = 'Amazon'" _
& "WHERE dbo_tblOrders.[sales-channel]='Amazon';", True
DoCmd.RunSQL "UPDATE dbo_AmazonOrderTable INNER JOIN dbo_tblOrders ON dbo_AmazonOrderTable.[order-id]=dbo_tblOrders.[channel-order-id] " _
& "SET dbo_AmazonOrderTable.[order-id] = dbo_tblOrders.[order-id], dbo_AmazonOrderTable.[channel-order-id] = dbo_tblOrders.[channel-order-id], " _
& "dbo_AmazonOrderTable.[sales-channel] = 'Amazon' " _
& "WHERE dbo_tblOrders.[sales-channel]='Amazon';", True
DoCmd.RunSQL "UPDATE dbo_tblSettings SET countervaule=1", True
Else
GoTo Exit_Button_Click
End If
Exit_Button_Click:
Exit Sub
Err_Button_Click:
MsgBox Err.Description
Resume Exit_Button_Click
End Sub
-OH! forgot to mention I want to do it this way because the tables are actually linked tables to a SQL server back-end... I've also been trying to figure out how to open the connection to my SQL server and manipulate the tables via the VBA code without having to link them in Access... but that's another post altogether
Any help will be greatly appreciated. Thanks
I think the problem is the line
If Value.waveset > 0 Then
Which should be
waveset.Value > 0 Then
.Value is a property - it comes after the object, but it is not itself an object. Thus, asking for the .waveset property of Value will give an error.
The same thing happens again a few lines later:
ElseIf Value.waveset = 0 Then
The advice that #HansUp gave in his comment is a good one. Write Option Explicit at the top of your module, then hit Debug->Compile. Your code will generate errors. Add statements of the form
Dim waveset
to the top of your function. Only declare variables you intend to use. Any remaining errors are now due to typos or other syntax / logic errors, and will be spotted more easily.
If you are sure you know what type a particular variable will be, it is marginally more efficient to declare as that type; so
Dim ii As Integer
For ii = 0 To 10000
...
is marginally more efficient than
Dim ii
For ii = 0 To 10000
But that's not what your question is about.
Yes, ...If Value.waveset > 0 ... does give an error Object Required
BOTH lines need to be changed, but need to be this syntax ---
If waveset.Fields("countervalue").Value > 0
...
ElseIf waveset.Fields("countervalue").Value = 0 Then
I have an Excel .xlam file that adds a button in the ribbon to do the following:
Scan the ActiveSheet for some pre-set parameters
Take my source text (a string value, hard coded directly in a VBA Module) and replace designated areas with the parameters retrieved from step 1
Generate a file containing the calculated text
I save the source text this way because it can be password protected and I don't need to drag another file around everywhere that the .xlam file goes. The source text is saved in a separate module called "Source" that looks something like this (Thanks VBA for not having Heredocs):
'Source Module
Public Function GetSource() As String
Dim s As String
s = ""
s = s & "This is the first line of my source text" & vbCrLf
s = s & "This is a parameter {par1}" & vbCrLf
s = s & "This is another line" & vbCrLf
GetSource = s
End Function
The function works fine. My problem is if I want to update the source text, I now have to manually do that in the .xlam file. What I would like to do is build something like a Sub ImportSource() in another module that will parse some file, rebuild the "Source" Module programatically, then replace that Module with my calculated source code. What I don't know is if/how to replace the source code of a module with some value in a string variable.
It's like metaprogramming at its very worst and philosophically I'm against doing this down to my very core. Practically, however, I would like to know if and how to do it.
I realize now that what you really want to do is store some values in your document in a way that is accessible to your VBA, but that is not readable to a user of the spreadsheet. Following Charles Williams's suggestion to store the value in a named range in a worksheet, and addressing your concern that you don't want the user to have access to the values, you would have to encrypt the string...
The "proper way" to do this is described in this article - but it's quite a bit of work.
A much shorter routine is found here. It just uses simple XOR encryption with a hard coded key - but it should be enough for "most purposes". The key would be "hidden" in your macro, and therefore not accessible to prying eyes (well, not easily).
Now you can use this function, let's call it encrypt(string), to convert your string to a value in the spreadsheet:
range("mySecretCell").value = encrypt("The lazy dog jumped over the fox")
and when you need to use it, you use
Public Function GetSource()
GetSource = decrypt(Range("mySecretCell").value)
End Function
If you use the XOR version (second link), encrypt and decrypt would be the same function...
Does that meet your needs better?
As #brettdj already pointed out with his link to cpearson.com/excel/vbe.aspx , you can programmatically change to code of a VBA module using the VBA Extensibility library! To use it, select the library in the VBA editor Tools->References. Note that you need to also change the options in your Trust center and select: Excel Options->Trust Center->Trust Center Settings->Macro Settings->Trust access to the VBA project object model
Then something like the following code should do the job:
Private mCodeMod As VBIDE.CodeModule
Sub UpdateModule()
Const cStrModuleName As String = "Source"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = Workbooks("___YourWorkbook__").VBProject
'Delete the module
VBProj.VBComponents.Remove VBProj.VBComponents(cStrModuleName)
'Add module
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = cStrModuleName
Set mCodeMod = VBComp.CodeModule
'Add procedure header and start
InsertLine "Public Function GetSource() As String"
InsertLine "Dim s As String", 1
InsertLine ""
'Add text
InsertText ThisWorkbook.Worksheets("Sourcetext") _
.Range("___YourRange___")
'Finalize procedure
InsertLine "GetSource = s", 1
InsertLine "End Function"
End Sub
Private Sub InsertLine(strLine As String, _
Optional IndentationLevel As Integer = 0)
mCodeMod.InsertLines _
mCodeMod.CountOfLines + 1, _
Space(IndentationLevel * 4) & strLine
End Sub
Private Sub InsertText(rngSource As Range)
Dim rng As Range
Dim strCell As String, strText As String
Dim i As Integer
Const cLineLength = 60
For Each rng In rngSource.Cells
strCell = rng.Value
For i = 0 To Len(strCell) \ cLineLength
strText = Mid(strCell, i * cLineLength, cLineLength)
strText = Replace(strText, """", """""")
InsertLine "s = s & """ & strText & """", 1
Next i
Next rng
End Sub
You can "export" and "import" .bas files programmatically. To do what you are asking, that would have to be the approach. I don't believe it's possible to modify the code in memory. See this article