Open databse file using VB input from user - vb6

Hi Want to open the file as per combobox is selected.
The below code is not working.
Set mydb1 = DBEngine.Workspaces(0).OpenDatabase("\\172.22.30.41\Training-Data\Training\Gaus\Vertical Updates & "\" & Combo1.Text & ".mdb")
Can anyone point me out what is wrong in the code please?

You have a syntax error in your string concatenation where the slash is between Updates and Combo1.Text. I added the db variable for easier readability on this page:
Dim db as string
db = "\\172.22.30.41\Training-Data\Training\Gaus\Vertical Updates\" & Combo1.Text & ".mdb"
Set mydb1 = DBEngine.Workspaces(0).OpenDatabase(db)

Related

How to get MST properties from vbscript

So, I am creating a vbscript that will read an MSI and MST file. The idea is that if the user that will run the script is testing an MSI with an MST file involved, the script should create a "report" of the new properties that this MST have.
I am able to get the properties from a regular MSI, the problem is when I am trying to get into the MST section. While doing research I found out about the _TransformView Table and this should help me to obtain this information but I think I am not sure I know how to handle that table.
Const msiTransformErrorViewTransform = 256
Const msiOpenDB = 2
Dim FS, TS, WI, DB, View, Rec
Set WI = CreateObject("WindowsInstaller.Installer")
Set DB = WI.OpenDatabase(msiPath,msiOpenDB)
DB.ApplyTransform mstPath, msiTransformErrorViewTransform
If Err.number Then
Exit Function
End If
For i = 0 To 24 'Number of properties on the arrPropertyList
Set View = DB.OpenView("Select `Value` From Property WHERE `Property` = " & "'" & arrPropertyList(i) & "'")
View.Execute
Set Rec = View.Fetch
If Not Rec Is Nothing Then
objLog.WriteLine arrPropertyList(i) & " = " & Rec.StringData(1)
End If
Next
That code will display the msi properties that I have added on the arrPropertyList. The thing is that I am looking for the MST properties and I am only getting the MSI ones. I know that I should change the Query to access the _TransformView Table when calling the DB.OpenView but not sure how can I get to this information! Any knowledge you can share would be welcome.
It works slightly differently to what you think. Run the following to see what I mean (maybe force the VBS to run with Cscript.exe from a command prompt if you're expecting a lot of output):
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiTransformErrorViewTransform = 256
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase("C:\Temp\Temp.msi",msiOpenDatabaseModeReadOnly)
oDatabase.ApplyTransform "C:\Temp\Temp.mst", msiTransformErrorViewTransform
'create a view of the registry we want to see
Dim sql : sql = "SELECT * FROM `_TransformView`"
Dim regView : Set regView = oDatabase.OpenView(sql)
'execute the query
regView.Execute
'fetch the first row of data (if there is one!)
Dim regRecord : Set regRecord = regView.Fetch
'whilst we've returned a row and therefore regRecord is not Nothing
While Not regRecord Is Nothing
'print out the registry key
wscript.echo "Table: " & regRecord.StringData(1)
wscript.echo "Column: " & regRecord.StringData(2)
wscript.echo "Row: " & regRecord.StringData(3)
wscript.echo "Data: " & regRecord.StringData(4)
wscript.echo "Current: " & regRecord.StringData(5)
wscript.echo "***"
'go and fetch the next row of data
Set regRecord = regView.Fetch
Wend
regView.Close
Set regView = Nothing
Set regRecord = Nothing
Set oDatabase = Nothing
Set oInstaller = Nothing
So if you only wanted to see changes in the Property table, you would change the SQL query to:
Dim sql : sql = "SELECT * FROM `_TransformView` WHERE `Table` = 'Property'"
As well as storing the column names of the changed entries, the 'Column' column in the '_TransformView' table also stores whether the value was inserted, removed etc by using the values:
INSERT, DELETE, CREATE, or DROP.
You can find lots of VBScript Windows Installer tutorials for reference - don't forget to set your objects to Nothing otherwise you'll leave handles open. And of course use the link you provided for further reference.
WiLstXfm.vbs: Are you familiar with the MSI SDK sample: wilstxfm.vbs (View a Transform)? It can be used to view transform files. Usage is as follows:
cscript.exe WiLstXfm.vbs MySetup.msi MySetup.mst
Mock-up output:
Property Value [INSTALLLEVEL] {100}->{102}
File DELETE [Help.chm]
I think all you need is in there? Maybe give it a quick look. There is a whole bunch of such MSI API Samples - for all kinds of MSI purposes.
Github.com / Windows SDK: These VBScripts are installed with the Windows SDK, so you can find them on your local disk if you have Visual Studio installed, but you can also find them on Github.com:
Github: WiLstXfm.vbs - Microsoft repository on github.com.
Disk: On your local disk, search under Program Files (x86) if you have Visual Studio installed. Current Example: %ProgramFiles(x86)%\Windows Kits\10\bin\10.0.17763.0\x86.

Find the name all tables in DBF database

I'm trying to find out the names of the tables.DBF, which are in a hard drive directory.
Subsequently, I need to know the names of their columns, but even the names of the tables I do not know how to find out. Standard SQL tools do not work, it's logical. The script is run on the site under IIS (win server 2008), VBScript. For the connection, I use the driver: AccessDatabaseEngine_X64.
The selection from the specific tables is working, create, delete the table - it works. Connection code:
<%#LANGUAGE="VBSCRIPT" CODEPAGE=1251%>
<%
Function OpenDBFConn(Path)
Dim Conn: Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & Path & ";" & _
"Extended Properties=""DBASE IV;"";"
Set OpenDBFConn = Conn
End Function
Dim DBConn
Set DBConn = OpenDBFConn("C:\update")
Dim Lel
Set Lel = DBConn.Execute("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE table_type='BASE TABLE'")
%>
The script result:
The Microsoft Access database engine could not find the object 'INFORMATION_SCHEMA.TABLES'. Make sure the object exists and that you spell its name and the path name correctly. If 'INFORMATION_SCHEMA.TABLES' is not a local object, check your network connection or contact the server administrator.
This is logical. Here, the methods for accessing the system table will not work, because they are not. Question - how do I know the names of the tables in the 'Update' folder? Screenshot of the folders:
1) Table names. As it's already mentioned, get table names (i.e. M1072R, M10201, etc.) by using FileSystemObject:
Set fs=Server.CreateObject("Scripting.FileSystemObject")
Set fo=fs.GetFolder("C:\update")
For Each x in fo.files
If LCase(fs.GetExtensionName(x.path)) = "dbf" Then
Response.Write fs.GetBaseName(x.path) & ";"
End if
Next
2) Column names:
'Dim Lel
'Set Lel = DBConn.Execute("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE table_type='BASE TABLE'")
Set rs=Server.CreateObject("ADODB.Recordset")
rs.Open "M1072R", DBConn
'-- where M1072R is your table/dbf file
For Each f In rs.Fields
Response.Write "Column=" & f.Name & ";"
Next
Another way to get columns is to use OpenSchema
Set rs=DBConn.OpenSchema(4, Array(Null, Null, "M1072R"))
'-- where M1072R is your table/dbf file,
'-- 4 stands for adSchemaColumns
Do While Not rs.EOF
Response.Write "Column=" & rs.Fields("COLUMN_NAME").Value & ";"
rs.MoveNext
Loop

Using HP-UFT, is Is there anyway to tell whether or not an object in the object repository is being used in other tests?

I'm currently using UFT -- I have a GUI test, and there's a web element object in one of my tests I'd like to delete/update, but I'm worried it's being referenced by another test in our test suite. (I am coming into a test suite that someone else built)
Is there anyway to tell whether or not an object in the object repository is being used in other tests? (Without having to go into each individual test and action to find out?)
My way would be simple recursive file search.
Open EditPlus
Search -> Find In Files
Find What =
File Type = *.mts | *.vbs | *.qfl
Folder =
Select the Include Sub Folder Check Box
Click Find
You can use Search>View>Find (or ctrl+F) from UFT and select to look in entire solution
Open "Script.mts" file from every action and search for your object name. If you find the object, write the script name and line number where your object exists, in a file.
Use the below code:
'strScriptsPath is the path where your test script folders are placed.
Set strScripts = objFSO.GetFolder(strScriptsPath).SubFolders
For Each Script In strScripts
strAction = strScriptsPath & "\" & Script.Name & "\Action1\Script.mts"
If objFSO.FileExists(strAction) Then
'Open Script in NotePad
Set strFile = objFSO.OpenTextFile(strAction, 1)
Do While Not (strFile.AtEndOfStream)
strLine = strFile.ReadLine
If InStr(1, strLine, strObjectName) > 0 Then
iVerificationCount = objSheet.UsedRange.Rows.Count
iCurrentRow = iVerificationCount + 1
objSheet.Cells(iCurrentRow, 1) = Script.Name
objSheet.Cells(iCurrentRow, 2) = strLine
If strFile.AtEndOfStream Then
objSheet.Cells(iCurrentRow, 3) = strFile.Line
Else
objSheet.Cells(iCurrentRow, 3) = strFile.Line - 1
End If
End If
Loop
strFile.Close
Set strFile = Nothing
End If
Next
Set strScripts = Nothing
To be able to use this code, declare objFSO object and write a piece of code to create an excel and get objSheet.
You can also replace the object name using the below code:
Use the For Each Loop as mentioned above
strScript = strScriptsPath & "\" & strScriptName & "\Action1\Script.mts"
strFind = "Old Object Name"
strReplace = "New Object Name"
Set strFile = objFSO.OpenTextFile(strScript, 1)
strData = strFile.ReadAll
strNewData = Replace(strData, strFind, strReplace)
strFile.Close
Set strFile = Nothing
Set strFile = objFSO.OpenTextFile(strScript, 2)
strFile.Write strNewData
strFile.Close
Set strFile = Nothing
** You just need to write this entire code in a .vbs file and run that file.

Open files with common name part

First of all, please excuse my shortcomings in presenting my issue as I haven't got much knowledge in VBA. Your help would be kindly appreciated.
I am working on a project that would imply putting the content of three different Excel files from three different sub-folders into one Excel file, and then run some macros in order to process the data they contain. Since I've already set the processing macros, my issue relies in importing the content correctly.
The problem I'm facing is that I don't have the exact names of the files I would like to open, and that they would change each month. Therefore, I can't use the "WorkBooks.Open" command that requires a precise name. However, the files have predictable name formats. For instance, one of the sub-folders will be comprised of files named "XXX-jan2013.xls", another one "january2013-XXX" and the last one "XXX-01/2013".
My goal would be to input the month and year manually, for instance “01/2013”, and then open all the files containing "January”, “jan” or “01" in their names.
Here’s what I have so far, with comments:
Sub ChosenDate()
‘It aims at opening a box in which the desired month would be written manually
Dim InputDate As String
‘These are the indications the user will get
InputDate = InputBox(Prompt:="Please choose a month.", _
Title:="Date", Default:="MM/YYYY")
‘In case the person forgets to write what he’s asked to
If InputDate = "MM/YYYY" Or _
InputDate = vbNullString Then
Exit Sub
‘If he does it correctly, I call the second Sub
Else: Call FilesOpening
End If
End Sub
‘So far, everything works fine
Public Sub FilesOpening()
‘This one aims at opening the chosen files
Dim ThisFile As String
Dim Files As String
‘Defining the folder in which the file is, as it can change from a computer to another
ThisFile = ThisWorkbook.Path
‘Here’s where I start struggling and where the macro doesn’t work anymore
‘If I wanted to open all the files of the folder, I would just write that:
Files = Dir(ThisFile & "\*.xls")
‘You never know…
On Error Resume Next
‘Creating the Loop
Do While Files <> vbNullString
Files = Dir
Set wbBook = Workbooks.Open(ThisWorkbook.Path & "\" & Files)
Loop
End Sub
‘But it doesn’t look inside of sub-folders, neither does it consider the date
Sub DataProcess()
‘This one is fine, except I can’t find a way to name the files correctly. Here’s the beginning:
Windows("I don’t know the name.xls").Activate
Sheets("Rapport 1").Select
Cells.Select
Selection.Copy
Windows("The File I Want To Put Data In.xlsm").Activate
Sheets("Where I Want To Put It").Select
Range("A1").Select
ActiveSheet.Paste
Windows("I don’t know the name.xls").Close
‘How can I get the name?
I hope my statement is understandable.
Thank you very much in advance!
Have a nice day,
E.
You need to build a list of the paths and the expected file masks. You can then loop each matching file and do your stuff.
Sub foo()
Dim request As String: request = "01/2013"
'//make a date
Dim asDate As Date: asDate = "01/" & request
Dim dirs(2) As String, masks(2) As String
dirs(0) = "c:\xxx\dir1\"
masks(0) = "*" & Format$(asDate, "mmmmyyyy") & "*.xls"
dirs(1) = "c:\xxx\dir2\"
masks(1) = "*" & Format$(asDate, "mmmyyyy") & "*.xls"
dirs(2) = "c:\xxx\dir3\"
masks(2) = "*" & Format$(asDate, "mmyyyy") & "*.xls"
Dim i As Long
For i = 0 To UBound(dirs)
GetFiles dirs(i), masks(i)
Next
End Sub
Private Function GetFiles(path As String, mask As String)
Dim file As String
'//loop matching files
file = Dir$(path & mask)
Do Until Len(file) = 0
'//process match
process path & file
file = Dir$()
Loop
End Function
Sub process(filePath As String)
MsgBox "processing " & filePath
'workbook.open
End Sub
As "XXX-01/2013" is not a file name I assumed "XXX-012013".
If its another subdirectory just:
dirs(x) = "c:\xxx\dir3\" & Format$(asDate, "mm") & "\"
masks(x) = "*" & year(asDate) & "*.xls"

How do I display an image from Sql Server with Microsoft Access?

I upsized an Access 2007 database to SQL Server 2008 R2. The images are in SQL Server as image type. Access has link to the table containing the image. When I try to display from within Access, it won't do it. It still has the OLE Object wrapper.
How can I get that image and display it on my forms in Access? I do not have the option, at the moment, to remove the images, put them in a directory and point to them (the best way I know but not an option). I need to read the image / blob file directly from SQL Server and display it on an Access form.
Thank you for any ideas.
I saw this but it did not help:
How to display image from sql server in ms access
http://access.bukrek.net/documentation looks like the file in folder method
Since Access 2010, you can use the PictureData property to store and display images from SQL Server. You will need a bound control for an SQL Server data type varbinary(max), which can be hidden, and an unbound Image control in MS Access. You can now simply say:
Private Sub Form_Current()
Me.MSAccessImageControl.PictureData = Me.SQLServerImage
End Sub
And vice versa. You will need to add some error management to that, but very little else.
Below is a function I have successfully used called BlobToFile. And I also posted the code that I use to test it. The picture gets dumped to a so-called temp file but its not truly temp because it isn't in the temp directory. You can manually delete the image file or else you'll have to write it to your temp folder instead. Then I have an image control where I display the picture.
Private Sub Command1_Click()
Dim r As DAO.Recordset, sSQL As String, sTempPicture As String
sSQL = "SELECT ID, PictureBlobField FROM MyTable"
Set r = CurrentDb.OpenRecordset(sSQL, dbSeeChanges)
If Not (r.EOF And r.BOF) Then
sTempPicture = "C:\MyTempPicture.jpg"
Call BlobToFile(sTempPicture, r("PictureBlobField"))
If Dir(sTempPicture) <> "" Then
Me.imagecontrol1.Picture = sTempPicture
End If
End If
r.Close
Set r = Nothing
End Sub
'Function: BlobToFile - Extracts the data in a binary field to a disk file.
'Parameter: strFile - Full path and filename of the destination file.
'Parameter: Field - The field containing the blob.
'Return: The length of the data extracted.
Public Function BlobToFile(strFile As String, ByRef Field As Object) As Long
On Error GoTo BlobToFileError
Dim nFileNum As Integer
Dim abytData() As Byte
BlobToFile = 0
nFileNum = FreeFile
Open strFile For Binary Access Write As nFileNum
abytData = Field
Put #nFileNum, , abytData
BlobToFile = LOF(nFileNum)
BlobToFileExit:
If nFileNum > 0 Then Close nFileNum
Exit Function
BlobToFileError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, _
"Error writing file in BlobToFile"
BlobToFile = 0
Resume BlobToFileExit
End Function

Resources