VB6 Set Printer Orientation on Runtime not working on some Printers - vb6

I have a code to print data report on vb6, I use this to change the layout or the orientation of printer, it was working on my last printer EPSON L210 I think it has Ip address as Port, but on Printer Epson L120 it's a network printer.. when i use error handler to check the error it says subscript out of range.
Dim obj As PageSet.PrinterControl
Dim mPointer
Set obj = New PrinterControl
mPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
DoEvents
If vOrientation = 1 Then
Printer.Orientation = vbPRORLandscape
obj.ChngOrientationLandscape
Else
obj.ReSetOrientation 'This resets the printer to portrait.
End If
Screen.MousePointer = mPointer
DoEvents

It's now working, the network should be name to your computer, so I add a local printer instead so I can have full permission of the printer and updated the driver locally.

Related

How to open AS400 emulator using Vbscript

I made a HTA app that needs to open As400 emulator but I can't make it work. This is my code.
Sub TestSub()
Dim sessName,sessNo,userName,pass,filePath,i,aw
sessName = document.getElementById("session").value
sessNo = document.getElementById("sessno").value
userName = document.getElementById("uname").value
pass = document.getElementById("psw").value
sessName = sessName&".WS"
filePath = "C:\Users\Public\Documents\IBM\Client Access\Emulator\Private\"&sessName&".ws"
'sessNo = sessNo*1
'For i = 0 to sessNo
Set autECLConnMgr = CreateObject("PCOMM.autECLConnMgr")
Set autECLConnList = CreateObject("PCOMM.autECLConnList")
Set autECLOIA = CreateObject("PCOMM.autECLOIA")
Set autECLPS = CreateObject("PCOMM.autECLPS")
Set autECLSession = CreateObject("PCOMM.autECLSession")
autECLConnList.Refresh()
autECLConnMgr.StartConnection("PROFILE=filePath CONNNAME=A WINSTATE=RESTORE")
autECLOIA.SetConnectionByName("A")
autECLPS.SetConnectionByName("A")
autECLOIA.WaitForAppAvailable()
autECLOIA.WaitForInputReady()
'Next
msgbox "Macro Finished!"
End Sub
I can't even open the emulator. Don't know what's wrong with my code since I'm just a beginner in making HTA apps. Thanks in advance!!
This is the error i get everytime I run it.

Get Computer Model witn WMIC

I'm, unable to retrieve the PC model in VB6, the property I request from the query returns empty. I try to emulate the result of this CMD command.
wmic computersystem get model
This is the code I try to use. (I added Microsoft WMI scripting lib 1.2 as a reference in the project).
Function wmiInfo() As String
Dim List
Dim Msg
Dim Object
On Local Error Resume Next
Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BaseBoard")
For Each Object In List
Msg = Msg & "Motherboard Serial Number: " & Object.Model & vbCrLf
Next
MsgBox Msg
end function
I expect the function to retrieve just a string with the model of the PC something like "Optiplex 790" (it is what the cmd command returns).
Any help is greatly appreciated.
(OS Windows 7)
I found the issue. I was requesting the wrong class.
Win32_computerSystem has the property I'm looking for.
Function wmiProcessorInfo() As String
Dim msg As String
Dim cpuSet As SWbemObjectSet
Dim cpu As SWbemObject
Dim itmx As ListItem
On Local Error Resume Next
Set cpuSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_ComputerSystem")
For Each cpu In cpuSet
msg = cpu.Model
Next
MsgBox msg
End Function

Winsock Error 429: activeX component can't create object

So I know that my code below works. The purpose is to create a tcp Ethernet connection between a scale and computer, so that when a weight is read on the scale, the value is displayed on the computer at the push of a button. I copied this code to a new lab machine that was just imaged for me. As for the winsock, I dynamically created it at run-time by adding it to the references. I understand that this is not what I am supposed to do (see: https://support.microsoft.com/en-us/kb/313984).
With a breakpoint at the CFixPicture_Initialize function, the code hits "set tcpC = new Winsock" line and breaks with error 429: avtiveX componenet can't create object. Does anybody have any ideas as to how I can get this license/get this Winsock control to work? Thanks!
Option Explicit
Private WithEvents tcpC As Winsock
Private Sub CFixPicture_Close()
Set tcpC = Nothing
End Sub
Private Sub CFixPicture_Initialize()
Set tcpC = New Winsock
tcpC.LocalPort = 0
tcpC.Connect "192.168.0.1", 8000
End Sub
Private Sub CommandButton1_click()
On Error GoTo errHandler
tcpC.SendData "S" & vbCrLf
Exit Sub
errHandler:
MsgBox "error:" & Err.Description
End Sub
Private Sub tcpC_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Dim strDataString As String
tcpC.GetData strData
strDataTrim = Mid(strData, 11)
Text1.Caption = "Weight: " & vbCrLf
The control is not present or is present but not registered on the new machine.
Copy over mswinsck.ocx from your *system directory to the new machines *system directory
Open a console as admnistrator and run regsvr32.exe c:\whatever\mswinsck.ocx
*\System32 or \SysWoW64 on 64 bit Windows.
As there was no license for the Winsock, I found a license online. I simply ran this program and voila! The Winsock worked. Thanks!
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4860&lngWId=1

VBScript 80004005; Was working as intended for hours, suddenly is not

I am new to VBScripting. Sorry for any mistakes, or lack of necessary information. I will do my best to include everything I can to help you help me.
My problem is when I execute the script, I get the following error:
Line: 22
Char: 5
Error: Unspecified error
Code: 80004005
Source: (null)
What is strange is that I had been running the same script multiple times all day without any issue. Now when I run it, the error is displayed. Nothing in the script changed. I have tried rebooting, but that seems to have done nothing.
Here is the code:
Call Main
Function Main
Dim IE
Dim pin
Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
Set objShellApp = CreateObject("Shell.Application")
Set IE2 = WScript.CreateObject("InternetExplorer.Application", "IE_")
pin=inputbox("Pin: ","Enter the pin to continue","")
IE.Visible = True
IE.Navigate "https://ps.hasdk12.org/admin/pw.html"
For Each objWindow in objShellApp.Windows
If LCase(objWindow.LocationName) = LCase("PowerSchool") Then
Set IE2 = objWindow
End If
WScript.Sleep (5)
Next
With IE2.Document
.getElementByID("fieldPassword").value = "username;" + pin
.getElementByID("btnEnter").click
End With
For Each objWindow in objShellApp.Windows
If LCase(objWindow.LocationName) = LCase("Start Page") Then
Set IE2 = objWindow
End If
WScript.Sleep (5)
Next
End Function
Most probably reasons why your script become faulty are variations in page loading time, or nuber of opened Shell Explorer and IE windows etc. All troubles because your script doesn't wait while IE loading page, it checks each Explorer window and just continues even if target window isn't found.
Try this code:
Call Main
Function Main()
Dim oIE
Dim sPin
Set oIE = WScript.CreateObject("InternetExplorer.Application", "IE_")
sPin = InputBox("pin: ","Enter the pin to continue", "")
oIE.Visible = True
oIE.Navigate "https://ps.hasdk12.org/admin/pw.html"
WaitIE oIE, "PowerSchool"
With oIE.Document
.getElementByID("fieldPassword").value = "username;" + sPin
.getElementByID("btnEnter").click
End With
WaitIE oIE, "PowerSchool"
End Function
Function WaitIE(oIE, sLocation)
Do Until (LCase(oIE.LocationName) = LCase(sLocation)) And (Not oIE.Busy) And (oIE.ReadyState = 4)
WScript.Sleep 5
Loop
End Function
I've removed second IE variable, why did you get IE2 via objShellApp.Windows? Maybe I miss something..? IMO you already have IE instance hence getting the same instance such way is not necessary, just control that instance you have. Also I've added separate function that waits IE to complete page loading.

How to access the database from the other system or server?

Using VB 6
How to access the database from the other system or server?
Code
Cn.ConnectionString = "Provider=Microsoft.jet.oledb.4.0; Data Source=" & _
App.Path & "\DC-CS.MDB"
Cn.Open
I don’t want to give the connection directly in my code, I want to select a connection and *.mdb file from the other system or same system or server.
What type of control I have to use in VB for connection testing and mdb file selection from the other system or server?
First thing I want to select a connection, if connection tested, then I want to select a *.mdb file from other system or server. How can I select a connection and *.mdb file in VB 6.
Please need VB 6 Code Help
You can use the Data Link Properties dialog to define an OLE DB connection string. You can start out by predefining the Provider and other attributes, and then let the user browse for an MDB file and choose it if you have predefined Jet 4.0 as the Provider.
Once this selection has been made you can persist the connection as a .UDL (Universal Data Link) file. UDLs were what replaced DSNs a long, long time ago. I'm amazed they get so little use.
Here is some sample code that lets your program specify a UDL and a default path for the user to browse for an MDB file. If the UDL does not exist, it opens the Data Link Properties dialog so the user can choose an MDB, and lets them Test Connection from that dialog before Oking or Canceling their settings. Once it has the connection fully defined it persists it as a .UDL file and opens the Connection object.
If the UDL file exists it opens the Connection using the specs in the UDL.
The key here is the DbOpenPromptSave() function.
'Requries references to:
' Microsoft ActiveX Data Objects x Library (x >= 2.5)
' Microsoft OLE DB Service Component 1.0 Type Library
Private Function DbOpenPromptSave( _
ByVal Conn As ADODB.Connection, _
ByVal UDLPath As String, _
Optional ByVal MDBSearchStartPath As String = "") As Boolean
'Returns True if user cancels the dialog.
On Error Resume Next
GetAttr UDLPath
If Err.Number Then
'No UDL, we need to prompt the user then create one.
On Error GoTo 0
Dim dlkUDL As MSDASC.DataLinks
Set dlkUDL = New MSDASC.DataLinks
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Persist Security Info=False;" _
& "Jet OLEDB:Engine Type=5;" _
& "Data Source=" & MDBSearchStartPath & "\;" _
& "Window Handle=" & CStr(Me.hWnd)
If Not dlkUDL.PromptEdit(Conn) Then
DbOpenPromptSave = True
Exit Function
End If
'Use a Stream as Unicode writer. Using a relative path to save
'respects the Current Directory of the process.
Dim stmUDL As ADODB.Stream
Set stmUDL = New ADODB.Stream
With stmUDL
.Open
.Type = adTypeText
.Charset = "unicode"
.WriteText "[oledb]", adWriteLine
.WriteText "; Everything after this line is an OLE DB initstring", _
adWriteLine
.WriteText Conn.ConnectionString
.SaveToFile UDLPath, adSaveCreateOverWrite
.Close
End With
Conn.Open
Else
Conn.Open "File Name=" & UDLPath
End If
End Function
Private Function DbActions() As Boolean
'Returns True on cancel.
Dim connDB As ADODB.Connection
Set connDB = New ADODB.Connection
If DbOpenPromptSave(connDB, "sample.udl", App.Path) Then
MsgBox "User canceled!"
DbActions = True
Exit Function
End If
DoDbOperations connDB 'Whatever you need to do until closing.
connDB.Close
End Function
The DbActions() function is simply an example of calling DbOpenPromptSave() to open the database. This function opens the database, calls DoDbOperations() (not shown) to actually work with the open database, and then closes the database Connection.
This example uses a relative path (current directory, usually the same as App.Path) for sample.udl and sets the MDBSearchStartPath (where the Select Access database dialog opens) to App.Path (because this dialog defaults to where the last CommonDialog had been opened).
So in other words...
It looks for/saves the UDL sample.udl in CD (usually App.Path), and the MDB selection dialog opens in App.Path. Whew.
I suppose just passing CurDir$() might have been clearer in this case.
I hope this comes close to what you were requesting, it was a little vague.
The MDB selection subdialog the user opens is pretty much a standard CommonDialog.ShowOpen dialog. The user should be able to browse for the MDB file on any drive including file shares on remote systems.
RBarry is referring to the fact that you can "share" a particular folder on one computer, so that it is accessible to another computer.
If two computers are named computer1 and computer2, then computer2 can share a folder on it's C: drive giving it some name like "sharedfolder". Then computer1 can access that folder using the path "\\computer2\sharedfolder".
If an application on computer1 can't use that path, then you can "map" a drive letter (like F:) to the path "\\computer2\sharedfolder". Then it just looks like the F: drive on computer1.
Share your App.Path to the domain. Then on the other system, point it's App.Path to your share.
If you want to dynamically select your path and/or file, then use the FileOpen dialog/control.
As for code examples, I haven't used real VB6 in almost 5 years, so I do not have any true examples or anyway to make one. The closest I can come is Excel VBA 6.5. Here is an example of a VBA function that I use in Excel to browse for and open an Access database:
Public Function OpenDB() As Boolean
'Open the Database and indicate if successful'
If IsOpen Then
OpenDB = True 'we are already open'
Exit Function
End If
If sFile = "" Then sFile = GetSetting("YourAppName", "History", "DBName")
With Application.FileDialog(msoFileDialogFilePicker)
'specify the file open dialog'
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Access Workbooks", "*.mdb"
.Filters.Add "All Files", "*.*"
.InitialFileName = sFile
.Title = "Open TIP Database"
.Show
If .SelectedItems.Count > 0 Then
sFile = .SelectedItems(1)
Else 'user canceled ...'
OpenDB = False
Exit Function
End If
End With
DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile
On Error Resume Next
DB.Open
If Err.Number <> 0 Then
MsgBox "Error(" & Err.Number & "): " & Err.Description, vbOKOnly + vbCritical, "Error in OpenDB"
OpenDB = False
Exit Function
End If
'Opened ok, so finsh-up and exit'
OpenDB = True
SaveSetting "YourAppName", "History", "DBName", sFile
End Function
You will have to replace the "Application.FileDialog" with a reference to a VB Forms FileDialog control/component, which you should drop onto your VB from from the toolbox (its actually a component-control, so it's not really visible).
You should expect that it will have some differences because these are GUI features and the VB Forms GUI is radically different from the Excel GUI. So the properties & settings might be different and you'll have to play around with them or look them up in VB Help.
Note: the GetSetting and SaveSetting stuff is just saving the last file name and path used in the registry, so that it can use it as the default location for the next time.

Resources