I have written a COM library on C++.
There is only 1 function in this library.
STDMETHODIMP TMyCodeBitmapGenerateImpl::GenerateMyFile(BSTR ATextToEncode,
BSTR APathToSaveFile)
Library name is MyCode_COM_Library
Library is registered in the system.
trying
DataString = "data123"
Filename = "D:\img.bmp"
with CreateObject("MyCode_COM_Library.TMyCodeBitmapGenerateImpl")
.GenerateMyFile(DataString,Filename)
end with
I'm getting error Object Required
Trying again
dim ws
dim wd
Set ws = CreateObject("MyCode_COM_Library.TMyCodeBitmapGenerateImpl")
Set wd = ws.GenerateMyFile(datastring, FileName)
same error.
In VB in References i added this library
Dim wd
Dim wa As MyCodeBitmapGenerate
datastring = "data123"
FileName = "D:\img123.bmp"
wd = wa.GenerateMyFile(datastring, FileName) ' the function returns int
After that the compilator selects
.GenerateMyFile
and giving error Expected Function or Variable
Please help me to connect VB and my COM library.
Thank You.
If i'm adding library in References and writing such code in VB than all OK
Private Sub Command1_Click()
Dim azclib As AztecCodeBitmapGenerate
ds = "12343445454243442Data1234567890"
fp = "D:\imgDS.bmp"
Set azclib = New AztecCodeBitmapGenerate
azclib.GenerateAztecFile ds, fp
End Sub
But if i'm trying to write this code in VBScript like
Dim dt
Dim fp
Dim we, ws
dt = "123456789"
fp = "C:\imgDT.bmp"
Set we = CreateObject("AztecCode_COM_Library.TAztecCodeBitmapGenerateImpl")
Call we.GenerateAztecFile(dt, fp)
then i have an error Object Required - 800A01A8 on Call we.GEnerateAztecFile (dt,fp).
I think that the object "we" is not created but i'm not sure
Related
I could not figure out whats the problem is
Sub Reportstart(oEvent As Object)
Dim oFeld As Object
Dim oForm As Object
Dim oDocument As Object
Dim oDocView As Object
Dim Arg()
oField = oEvent.Source.Model
oForm = oField.Parent
sURL = oForm.DataSourceName
oDocument = StarDesktop.loadComponentFromURL(sURL, "C:\Users\Nameless\Desktop\Latest.odb", 0, Arg() )
oDocView = oDocument.CurrentController.Frame.ContainerWindow
oDocView.Visible = False
oDocument.getCurrentController().connect
Wait(100)
oDocument.ReportDocuments.getByName("report_student").open
oDocument.close(True)
End Sub'
The error is BASIC runtime error.
Argument is not optional.
Reportstart requires an argument oEvent, and the way you executed it, the subroutine was not given any argument.
The macro was designed to be called from an event handler of a control, for example, the Execute action of a push button on a Base form. Perhaps you executed the subroutine from the LibreOffice Basic IDE instead.
Related: https://ask.libreoffice.org/en/question/192344/argument-is-not-optional/
I have a requirement of converting a zip file from my local machine to base64.
Get/Read the path name from the excel sheet row
convert the file in the path (zip file) to base 64 string
Copy the base 64 value to next column in the excel sheet.
Tried a few but did not work.
Current Code:
Dim inByteArray, base64Encoded
inByteArray = readBytes("F:path/file.zip")
base64Encoded = encodeBase64(inByteArray)
Private Function readBytes(file)
Dim inStream
' ADODB stream object used
Set inStream = CreateObject("ADODB.Stream")
' open with no arguments makes the stream an empty container
inStream.Open
inStream.Type = TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
End Function
Private Function encodeBase64(bytes)
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.CreateElement("tmp")
EL.DataType = "bin.base64"
' Set bytes, get encoded String
EL.NodeTypedValue = bytes
encodeBase64 = EL.Text
End Function
Error 1 in the line inStream.type = TypeBinary:
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
Error 2 in the line readBytes = inStream.Read():
Operation is not allowed in this context.
Error 3 in the line EL.NodeTypedValue = bytes:
Type mismatch
Looks like you got the code from here, but didn't include
Const TypeBinary = 1
Adding this will avoid the "Arguments are of the wrong type ..." error.
Perhaps careful copy will solve your other problems too.
Thanks for that :)
Further for excel sheet read and write I used the below code which helped in achieving my target. Thank you
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("F:\path")
Set ws = objWorkbook.Sheets("Sheet1")
Set ws2 = objWorkbook.Sheets("Sheet2")
rowcount = ws.usedrange.rows.count
for j = 1 to rowcount
fieldvalue = ws.cells(j,1)
inByteArray = readBytes(fieldvalue)
base64Encoded = encodeBase64(inByteArray)
ws2.cells(j,1) = base64Encoded
next
I'm trying to put together tests in HP Unified Functional Testing
the way a programmer would.
For those unaware, the tool uses VBScript as its driver.
Because I want to use data from the same DataTable across multiple UFT actions
-- and because the Global table already has a different set of data on it
-- I want to retrieve data from an external file.
UFT happily supports this function.
My current plan is that, depending on which test I'm running,
I will iterate through only a range of rows in that table.
This is the script I've come up with:
' targets the local sheet, but
' not the same value as dtLocalSheet
Const sheetNum = 2
dim sheetRowCount
DataTable.ImportSheet "PersonFile.xlsx", 1, sheetNum
sheetRowCount = DataTable.GetSheet(sheetNum).GetRowCount
dim firstRow, lastRow
firstRow = Parameter("FirstPersonIndex")
lastRow = Parameter("LastPersonIndex")
If sheetRowCount < lastRow Then
lastRow = sheetRowCount
End If
If sheetRowCount >= firstRow Then
Dim i
For i = firstRow To lastRow
DataTable.SetCurrentRow i
' begin payload
MsgBox(DataTable.Value("LastName", dtLocalSheet))
' end payload
Next
End if
I don't want to have to repeat all this boilerplate
every time I want to use this pattern.
I'd really like to have something like:
In a Function Library:
sub LoopThroughSheetAnd(sheetFile, doThis)
' targets the local sheet, but
' not the same value as dtLocalSheet
Const sheetNum = 2
dim sheetRowCount
DataTable.ImportSheet sheetFile, 1, sheetNum
sheetRowCount = DataTable.GetSheet(sheetNum).GetRowCount
dim firstRow, lastRow
firstRow = Parameter("FirstRow")
lastRow = Parameter("LastRow")
If sheetRowCount < lastRow Then
lastRow = sheetRowCount
End If
If sheetRowCount >= firstRow Then
Dim i
For i = firstRow To lastRow
DataTable.SetCurrentRow i
call doThis()
Next
End if
end sub
In the original action...
sub Payload1()
MsgBox(DataTable.Value("LastName", dtLocalSheet))
end sub
LoopThroughSheetAnd "PersonFile.xlsx", Payload1
In a separate action, 3 or 4 steps later...
sub Payload2()
' compare the data against another data source
end sub
LoopThroughSheetAnd "PersonFile.xlsx", Payload2
The above code doesn't work in VBScript.
A type mismatch error is thrown
as soon as we try to pass Payload1 as a parameter.
How could one reasonably pull this off in VBScript?
Bonus points if the answer also works in UFT.
You can pass functions as parameters with the GetRef() function. Here's a utility map function, like you'd find in JavaScript that accepts an array and calls a function for each element of the array:
Sub Map(a, f)
Dim i
For i = 0 To UBound(a)
' Call a function on each element and replace its value with the function return value
a(i) = f(a(i))
Next
End Sub
Map MyArray, GetRef("SomeFunc")
Now you could write SomeFunc so that it operates on a value and returns an updated value:
Function SomeFunc(i)
SomeFunc = i + 1
End Function
This works fine. map calls SomeFunc using the function "pointer" we passed to it.
You could do something similar with your LoopThroughStreetAnd function:
LoopThroughStreetAnd "PersonFile.xlsx", GetRef("Payload2")
The standard way of callbacks in VBScript uses GetRef, as in this demo.
When using objects, you can wrap a call to a method in an object, and then you can pass the object. (This is approximately what happens in other languages already, you just have to do it manually in VBScript.)
The only issue is that any method called this way has to be Public.
I would use a naming scheme of something like "Func1", "Func2", "Action1", "Action2", etc., depending on the arity of the functions and whether they return values or not.
Dim s : Set s = New Something : s.Run
Class Something
Public Sub HowToPassMe(pValue)
WScript.Echo pValue
End Sub
Public Sub Run
Dim action : Set action = New Action1Wrapper
Set action.Target = Me
Dim se : Set se = New SomethingElse
se.DoSomethingElse action
End Sub
End Class
Class SomethingElse
Public Sub DoSomethingElse(pAction1)
pAction1.Action1("something")
End Sub
End Class
Class Action1Wrapper
Private mTarget
Public Property Set Target(value) : Set mTarget = value : End Property
Public Sub Action1(p1)
mTarget.HowToPassMe(p1)
End Sub
End Class
Using Execute, Action1Wrapper can also be written something like the following. You can also write a factory class for easier use.
Class Action1Wrapper
Private mTarget
Public Property Set Target(value) : Set mTarget = value : End Property
Private mName
Public Property Let Name(value) : mName = value : End Property
Public Sub Action1(p1)
Execute "mTarget." & mName & "(p1)"
End Sub
End Class
Class Action1Factory_
Public Function Create(pTarget, pName)
Dim a1 : Set a1 = New Action1Wrapper
Set a1.Target = pTarget
a1.Name = pName
Set Create = a1
End Function
End Class
Dim Action1Factory : Set Action1Factory = New Action1Factory_
Used as:
Dim action : Set action = Action1Factory.Create(Me, "HowToPassMe")
Dim se : Set se = New SomethingElse
se.DoSomethingElse action
And as I write the question, my memory gets jogged,
and I begin researching a "feature" I once discovered.
This fails to work in the context of HP UFT,
but if you're running cscript, or working with Classic ASP,
you can either declare a function late, or replace a previous declaration,
to change how it works.
VBScript lets you declare the same function or subroutine
multiple times in a program.
It treats the last declaration as the correct one.
You can get around this in cscript and ASP by physically separating
the different versions of the function,
so that one doesn't get clobbered by the other.
You'll have to be careful not to put the two anywhere near each other,
or you(r successor) might have an aneurysm trying to debug the outcome.
Honestly, you're probably better served refactoring your code some other way.
Now, with the disclaimers out of the way,
the following example is for use with cscript or wscript.
Code
Since this won't work in UFT anyway, I'll write from scratch.
In WrapperSub.vbs:
' Sub WrapperSub_Payload doesn't exist in this file.
' It must be declared by the calling file or the program will crash.
Sub WrapperSub()
wscript.echo("This begins the wrapper.")
WrapperSub_Payload
wscript.echo("This ends the wrapper.")
End Sub
In WrapperSubUseA.vbs:
With CreateObject("Scripting.FileSystemObject")
call ExecuteGlobal(.openTextFile("WrapperSub.vbs").readAll())
End With
Sub WrapperSub_Payload
wscript.echo("This is payload A.")
End Sub
WrapperSub
In WrapperSubUseB.vbs:
With CreateObject("Scripting.FileSystemObject")
call ExecuteGlobal(.openTextFile("WrapperSub.vbs").readAll())
End With
Sub WrapperSub_Payload
wscript.echo("This is payload B.")
End Sub
WrapperSub
Output
>cscript wrappersubusea.vbs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.
This begins the wrapper.
This is payload A.
This ends the wrapper.
>cscript wrappersubuseb.vbs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.
This begins the wrapper.
This is payload B.
This ends the wrapper.
Note that if a placeholder for WrapperSub_Payload
were declared in the source file,
that placeholder would always execute instead of the intended subroutine.
This is probably due to ExecuteGlobal
executing after the current file is parsed,
causing the placeholder to load after the local declaration.
When you try this in UFT --
placing the contents of WrapperSub.vbs in a function library --
the function library rightfully ignores the caller's scope.
It will then fail because WrapperSub_Payload doesn't exist in scope.
I am using GetDriveSerialNumber() to retrieve drive volume serial number in visual basic 2010.
I have the following imports:
Imports System
Imports System.IO
Imports System.Text
Imports System.Net.NetworkInformation
Imports System.Management
Imports System.Collections
Imports Microsoft.Win32
Imports Microsoft.VisualBasic
And then in the Module:
Dim path As String
'Get HD volume Serial Number from Function
Dim DriveVID As String = GetDriveSerialNumber()
The function is:
'Get HD Volume serial Number
Public Function GetDriveSerialNumber() As String
Dim DriveSerial As Long
Dim fso As Object, Drv As Object
'Create a FileSystemObject object
fso = CreateObject("Scripting.FileSystemObject")
Drv = fso.GetDrive(fso.GetDriveName(AppDomain.CurrentDomain.BaseDirectory))
With Drv
If .IsReady Then
DriveSerial = .SerialNumber
Else '"Drive Not Ready!"
DriveSerial = -1
End If
End With
'Clean up
Drv = Nothing
fso = Nothing
GetDriveSerialNumber = Hex(DriveSerial)
End Function
This works great for 9 out 10 computers,
Only one gives me back a different 7 characters,
Oppose to the 8 characters it should give me,
Even when I type vol command in cmd,
On that computer,
It gives me the correct 8 characters volume serial number,
Does anyone know what’s wrong?
This Function seems to work with all my test computers:
Private Function GetDriveSerialNumber(ByVal drive As String) As String
Dim driveSerial As String = String.Empty
Dim driveFixed As String = Path.GetPathRoot(drive)
driveFixed = Replace(driveFixed, "\", String.Empty)
Using querySearch As New ManagementObjectSearcher("SELECT VolumeSerialNumber FROM Win32_LogicalDisk Where Name = '" & driveFixed & "'")
Using queryCollection As ManagementObjectCollection = querySearch.Get()
Dim moItem As ManagementObject
For Each moItem In queryCollection
driveSerial = CStr(moItem.Item("VolumeSerialNumber"))
Exit For
Next
End Using
End Using
Return driveSerial
End Function
The only thing is that you have to send a drive letter to the Function,
Which is not a problem with me,
I'm having some trouble with looping and creating MS Excel docs, code snippet below
Private Sub selectedRowsButton_Click( _
ByVal sender As Object, ByVal e As System.EventArgs) _
Handles selectedRowsButton.Click
Dim selectedRowCount As Integer = _
DataGridView1.Rows.GetRowCount(DataGridViewElementStates.Selected)
If selectedRowCount > 0 Then
Dim sb As New System.Text.StringBuilder()
Dim objexcel As New Excel.Application
Dim i As Integer
Dim FACode As Integer
Dim Sitename As Integer
Dim Sitecode As Integer
Dim Address As Integer
Dim City As Integer
Dim State As Integer
Dim ZIP As Integer
FACode = 1
Sitename = 5
Sitecode = 2
Address = 6
City = 7
State = 9
ZIP = 10
Dim xlWorkbook As Excel.Workbook
xlWorkbook = objexcel.Workbooks.Open("template path")
For i = 0 To selectedRowCount - 1
objexcel.Visible = True
objexcel.Range("B2").Value = DataGridView1.SelectedCells(Sitename).Value.ToString()
objexcel.Range("B3").Value = DataGridView1.SelectedCells(Sitecode).Value.ToString()
objexcel.Range("B5").Value = DataGridView1.SelectedCells(FACode).Value.ToString()
Dim thisfile As Object
thisfile = objexcel.Range("B5").Value & "." & _
objexcel.Range("B3").Value & "." & "otherstring" & "." & "otherstring2" & "." & ".xls"
With objexcel
xlWorkbook.SaveAs(Filename:="c:\test\" & thisfile)
'~~> Close the Excel file without saving
xlWorkbook.Close(False)
End With
Next i
End If
I'm getting the error Exception from HRESULT: 0x800A03EC for the statement
objexcel.Range("B2").Value = DataGridView1.SelectedCells(Sitename).Value.ToString()
IF I select only one row of my DataGrid before creating the program works fine, it is when I select multiple rows that this error occurs. Since I'm creating the program specifically for multiple row selections I'm stumped as to where I've gone wrong. Any help or pointers appreciated, Thanks!
Two things
You have declared objexcel As Excel.Application so you shouldn't use objexcel.Range("B2").Value. Use xlWorkbook.Range("B2").Value. Change it everywhere in your code.
You cannot use SaveAs like that. See the snapshot below. If you want to save as xls file then you have to use FileFormat:=56
See this code example
'~~> Save As file
xlWorkbook.SaveAs(Filename:="c:\test\" & thisfile, FileFormat:=56)
If you do not specify the file format then you will get an error message when you open the file after opening.
You might want to look at this link on how to automate Excel from VB.Net
Topic: VB.NET and Excel
Link: http://www.siddharthrout.com/vb-dot-net-and-excel/
I am not too sure what you exactly are trying to do with the DGV. Like Sean mentioned you are not incrementing the values. If you can post a snapshot of how your DGV looks and how your Excel file should look after the export then we can help you in a much better way :)