A personal repository of random information in compensation for a fatigued biological computer
Breaded IT » VBA
Excel use ADODB connect, also need to research ADODB.command as can be more efficient for single results.
Note: VBA - Tools -> References to enable ADO library if necessary
Sub SQLDATA()
' Requires reference to Microsoft Active X Data object 2.x (Tools > References)
Dim cn As New ADODB.connection
Dim cmd As String
Dim rs As New ADODB.Recordset
Dim Proposalid As Variant
Dim Portfolio As String
Dim PasteABC As String
ServerName = "IM-PROJECT-MGR"
DbName = "MyFRST"
UserID = "SA"
Password = "password"
Const stADO As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=False;" & _
"Initial Catalog=MyFRST;" & _
"Data Source=IM-PROJECT-MGR"
' DS - can be updated to environment - this currently points to my local DB
cn.Open stADO
Sheets("RankingTool").Activate
Range("A8").Select
Do Until IsEmpty(ActiveCell.Value)
Proposalid = ActiveCell
ActiveCell.Offset(0, 5).Select
Portfolio = ActiveCell
ActiveCell.Offset(0, 5).Select
PasteABC = ActiveCell.Address
cmd = "exec sp_getRecomendationGrade " & Proposalid & ",'" & Portfolio & "'"
rs.Open cmd, cn
If Not rs.EOF Then
PasteABC = rs.Fields(0)
End If
ActiveCell.Offset(1, -10).Select
Set rs = Nothing
Loop
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
Phantom / Invisible breakpoints in MS Access 2003
A known issue..:
All you have to do is to enter a blank line anywhere in your code (simply so
that you can use the Compile command), Clear All Breakpoints, Compile and
then save. This will get rid of the invisible breakpoints.
VBScript *.vbs working with fso
option explicit Dim fso, folder, file Dim sCurPath, sExtension Dim sNewPrefix Dim sNewName ' Where are we sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".") ' Confirm path & get prefix sNewPrefix = InputBox("Enter prefix to add to ALL .tif files in this folder") if sNewPrefix <> "" then ' Manjula has entered a file prefix so proceed set fso = CreateObject("Scripting.FileSystemObject") set folder = fso.GetFolder(sCurPath) For Each file In folder.Files ' get the file extension sExtension = fso.GetExtensionName(file.Name) ' Just .tif files for now if ucase(sExtension) = "TIF" then ' remove the extension sNewName = Replace(file.Name, "." & sExtension, "") ' new name is user prefix + 1st three chars + orig extension sNewName = sNewPrefix & left(sNewName,3) & "." & sExtension ' Do the rename fso.MoveFile file.Name, sNewName end if Next Set file = Nothing Set folder = Nothing Set fso = Nothing end if