Apply working Shell code in a different database - vba

I have used the "Shell" function, in other Access databases, to open folders.
With the same code structure I get the
5 error code of "Invalid procedure call or argument"
Using shell function as follows:
Dim FreightFile_Path As String
FreightFile_Path = "S:\Supply Chain\Freight"
Shell "explorer.exe" & " " & FreightFile_Path, vbNormalFocus
I tried the double quotes and Chr(34)'s around them.
I copied the code from one database (that it worked in) to another and it error-ed.
Am I missing something I need to activate in MS Access? I checked the references in VBA and made sure they match.
Things I tried:
Call Shell("explorer.exe" & " " & Chr(34) & "S:\Shared" & Chr(34),
vbNormalFocus)
Shell "explorer.exe " & Chr(34) & FreightFile_Path & Chr(34), vbNormalFocus
Shell "explorer.exe" & " " & FreightFile_Path, vbNormalFocus
Dim retVal
retVal = Shell("explorer.exe" & " " & FreightFile_Path, vbNormalNoFocus)
Dim i As String
i = "explorer.exe" & " " & FreightFile_Path
Shell i, vbNormalFocus
FreightFile_Path = "S:\Supply Chain\Freight"
Shell "explorer.exe " & FreightFile_Path, vbNormalFocus
Restarted the application, restarted the computer.

I just had the same problem. In my case, it turned out to be anti-virus that was blocking Shell. It just so happened that IT had put exceptions in place for my computer for one database but not the other. See my question and answer for more detail.

Try this:
FreightFile_Path = "S:\Supply Chain\Freight"
Shell "cmd /c start explorer.exe """ & FreightFile_Path & """"
It is a bit of a workaround, but it works...

New try. Use a WinAPI call
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal lpnShowCmd As Long) As Long
Public Sub ShellEx(ByVal Path As String, Optional ByVal Parameters As String, Optional ByVal HideWindow As Boolean)
If Dir(Path) > "" Then
ShellExecute 0, "open", Path, Parameters, "", IIf(HideWindow, 0, 1)
End If
End Sub
Sub Test()
FreightFile_Path = "S:\Supply Chain\Freight"
ShellEx "c:\windows\explorer.exe", """" & FreightFile_Path & """"
End Sub

Thank you everybody for the help. This might not really be an answer to the Shell problem, but it will work for opening a file path.
Dim FreightFilePath As String
FreightFilePath = "S:\Supply Chain\Freight"
Application.FollowHyperLink FreightFilePath

Related

Start Octave Script from VBA with a batch file and wait for Octave to finish before continuing with vba

i would like to call an Octave script from VBA with a batch file and passing some arguments to it.
The Octave script creates a .csv file which is needed in the VBA code later on.
The Problem is, that the VBA code doesn't wait for Octave creating the .csv file and i get an error message that the file is not there. So i need a way to wait until Octave has created the file.
Here is my VBA code:
Public Sub LinkOctave(ByVal Projekt As String, ByVal Winddaten As String, ByVal Ak As String, ByVal Typ As String, _
ByVal Anz As Double, ByVal NH As Double, ByVal Netto As Double, _
ByVal StartGW As Double, ByVal EndGW As Double, _
ByVal StartP As Double, ByVal EndP As Double)
Dim PID As Variant
Dim BatchFilePath As String
Dim ProjektBat As String
Dim WinddatenBat As String
Dim AkBat As String
Dim TypBat As String
Dim AnzBat As Double
Dim NHBat As String
Dim NettoBat As String
Dim StartGWBat As String
Dim EndGWBat As String
Dim StartPBat As String
Dim EndPBat As String
ProjektBat = "'" & Projekt & "'"
WinddatenBat = "'" & Winddaten & "'"
AkBat = "'" & Ak & "'"
TypBat = "'" & Typ & "'"
AnzBat = Anz
NHBat = str(NH)
NettoBat = str(Netto)
StartGWBat = str(StartGW)
EndGWBat = str(EndGW)
StartPBat = str(StartP)
EndPBat = str(EndP)
BatchFilePath = "C:\Users\bla\Documents\Octave\PFM\runfctPFM.bat"
PID = Shell(BatchFilePath & " " & ProjektBat & " " & WinddatenBat & " " & AkBat & " " & _
TypBat & " " & AnzBat & " " & NHBat & " " & NettoBat & " " & StartGWBat & " " & _
EndGWBat & " " & StartPBat & " " & EndPBat)
End Sub
I already found the way to do it with wsh.Run like this:
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim lngErrorCode As Long
lngErrorCode = wsh.Run(BatchFilePath & " " & ProjektBat & " " & WinddatenBat & " " & AkBat & " " & _
TypBat & " " & AnzBat & " " & NHBat & " " & NettoBat & " " & StartGWBat & " " & _
EndGWBat & " " & StartPBat & " " & EndPBat, windowStyle, waitOnReturn)
If lngErrorCode <> 0 Then
MsgBox "Something went wrong with the batch file!"
Exit Sub
End If
But it still doesn't wait for Octave to finish.
What did i wrong? Or is there another solution?
This is the code of the bat file, where i call the octave script:
#echo off
set OCT_HOME=C:\Octave\Octave-5.1.0.0\mingw64\
set "PATH=%OCT_HOME%\bin;%PATH%"
set SCRIPTS_DIR=%~dp0
set ProjektBat=%1
set WinddatenBat=%2
set AkBat=%3
set TypBat=%4
set AnzBat=%5
set NHBat=%6
set NettoBat=%7
set StartGWBat=%8
set EndGWBat=%9
shift /1
set StartPBat=%9
shift /1
set EndPBat=%9
start octave-cli.exe --eval "cd(getenv('SCRIPTS_DIR')); fctPFM(%ProjektBat%, %WinddatenBat%, %AkBat%, %TypBat%, %AnzBat%, %NHBat%, %NettoBat%, %StartGWBat%, %EndGWBat%, %StartPBat%, %EndPBat%); quit;"
Thanks for your support
Cheers
The bat file has a 'start' command in it which according to the Microsoft docs opens a separate command prompt for the command - so its not going to wait for the separate command window to finish.
https://learn.microsoft.com/en-us/windows-server/administration/windows-commands/start
Note also in windows, you should probably not be calling the octave executables directly, rather use the .bat files that come with it, as they set up expected environment variables in order for octave to run correctly.

from VBA, run a search in explorer within a designated folder

I'm relatively new to VBA and working on something for work that will launch a given folder in explorer, run a search in explorer for files in that folder whose names contain a certain string, and show me the results in explorer. I've been using shell, and was able to individually open a specific folder, and run a search...but I can't figure out how to do both tasks simultaneously.
Here's some different things I've tried: nothing has worked.
Sub search_Files()
Dim folderName As String
folderName = "\\Users\itsMe\Documents"
Call Shell("C:\WINDOWS\explorer.exe "" "" & folderName _
&"" ""&search-ms://query=h&", vbNormalFocus)
Call Shell("explorer.exe "" ""search-ms:query=h&crumb=location:\\Users\itsMe\Documents", vbNormalFocus)
Call Shell("C:\WINDOWS\explorer.exe"" & FolderName &", vbNormalFocus)
RetVal = Shell( _
"c:\Windows\explorer.exe ""search-ms:displayname=Search%20Results&crumb=\\Users\itsMe\Documents" _
& h & "%20kind%3A%3Dfolder&crumb=location:" _
& folderName, vbNormalFocus)
End Sub
Could someone please provide me with the proper code on how to do this? (I want to use shell.)
Try this - it worked for me...
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=*.pdf&crumb=location:c:\ad\" & Chr(34), vbNormalFocus)
Do you mean your code need to replace the fifth one as below? I am tried to modify the related destination folder already. But still fail. Not sure I did wrong in which step.
Sub search_Files()
Dim folderName As String
folderName = "C:\Users\lkam\Documents"
Call Shell("C:\WINDOWS\explorer.exe "" "" & folderName _
&"" ""&search-ms://query=h&", vbNormalFocus)
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=*.pdf&crumb=location:c:\ad\" & Chr(34), vbNormalFocus)
Call Shell("C:\WINDOWS\explorer.exe"" & FolderName &", vbNormalFocus)
RetVal = Shell( _
"c:\Windows\explorer.exe ""search-ms:displayname=Search%20Results&crumb=C:\Users\lkam\Documents" _
& h & "%20kind%3A%3Dfolder&crumb=location:" _
& folderName, vbNormalFocus)
End Sub

Run command prompt commands as admin

I can use the following code to run a command from vba in the command prompt window
Private Sub CMDTest()
'command for cmd to execute
Dim command As String
command = "dir"
Call Shell("cmd.exe /S /K" & command)
End Sub
However it does not run with admin privileges. If command was something that required administrative privileges, how can I run it from vba with administrative privileges?
I have tried to used ShellExecute various ways and have had no luck. The code I used is below, I can open the command prompt window as an admin, however can not run the dir command.
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Public Sub test()
ShellExecute 0, "runas", "cmd.exe", "", vbNullString, SW_SHOWNORMAL
End Sub
Well, I may be late! say it is for the record :) Trying to answer the same question, the other topics I've read do not mention vba so I propose here a way to do it.
What it does: run wsshl from vba that opens a cmd prompt that test
current user rights, if not admin then it opens a powershell window
that opens a cmd prompt in admin mode that runs some cmd line
arguments... in one go (late binding, just msdos)
The trick: instead of running an external batch file or else, all
command are send in assembly line using dos & operator.
The problem: VBA wont wait for the last opened cmd window
(asynchrone) so I added... another cmd prompt to serve as 'waitonrun'
but also to check that no terrible thing happened. If there is no
need to wait or verify anything, they can be 'released'.
How it works: Enter your cmd arguments in mycmd variable, it can be
parametrized with vba variables, and run/compile. the UAC will prompt
to open a cmd window in admin mode and then follow the instructions.
Other possible use: use psargsList="echo." in psmeth 2, access to
last cmd prompt (admin mode) will be granted if you want to type
other commands instead of sending a bunch of arguments. In that case
the 'waitonrun' prompt allow to pause vba until you finished.
Here an example to take back ownership of a file using icacls.
Sub acmd()
'--------
'settings
'--------
Dim output As String: output = Environ("userprofile") & "\Desktop\test.txt" ' a file
Dim mycmd As String: mycmd = "icacls " & output & " /grant %username%:F " 'an msdos cmd to run as admin
'---------
'2 methods
'---------
'exact same versions but different syntax, the first is shorter, the second uses -ArgumentList argument of powershell that can be usefull in other cases
'note: first run of powershell may take some time
Dim psmeth As Long: psmeth = 1 '2
Dim psargsList As String, psargs As String
'------
'layout
'------
'trying to lighten a bit the expression and the cmd prompt
'msg could also be other cmd arguments
Dim msg1 As String, msg2 As String, msg3 As String
msg1 = "echo.& echo.""- listing files with ownership"" & echo."
msg2 = "echo.& echo.""- applying cmd"" & echo.& echo. "
msg3 = "echo.& echo.""Done! now press [enter]"" & echo."
With CreateObject("wScript.Shell")
If psmeth = 1 Then
'add an msdos '&' between msdos args and cut the vba string with a vba '&' where you want to insert vba variables
'from the last cmd point of view it will be the same cmd line, a succession of cmd arg1 & arg2 & arg3, the 'encapsulation' between \"""" is a bit more tricky
'there are some warnings you can see when using -noexit after powershell cmd but it doesn't seems to hurt
psargs = msg1 & " & dir " & output & " /q & " & msg2 & " & " & mycmd & " & " & msg3 & " & pause"
.Run "cmd /c net session >nul 2>&1 & if ERRORLEVEL 1 ( Powershell -Command ""& { Start-Process cmd.exe \""""/c " & psargs & "\"""" -verb RunAs -wait }"" )", 1, True ' 3rd win only? ok too; add -noexit after Powershell to see warnings
ElseIf psmeth = 2 Then
'based on same principle, it works also with powershell's -ArgumenList 'arg1','& arg2','& arg3',.. syntax, there is a little less escaping but it needs to open a '4th' cmd window with /k (and VBA wont wait for it!) so that it doesn't close and runs cmd line args in assembly line
'the cuts '...', are arbitrary, then inside them cut the vba string to insert vba variables
psargsList = "-ArgumentList 'cmd /k ','" & msg1 & " & echo. &','dir " & output & " /q ',' & echo. & " & msg2 & "',' & " & mycmd & " ','& " & msg3 & " & pause ','& exit'"
.Run "cmd /c net session >nul 2>&1 & if ERRORLEVEL 1 ( Powershell -Command ""& { Start-Process cmd.exe " & psargsList & " -verb RunAs -wait }"" )", 1, True
End If
If psmeth = 1 Or psmeth = 2 Then
'we need some 'waitonrun', here a simple confirmation window
.Run "cmd /c tasklist |find ""cmd.exe"" >nul && (set /p""= Holding on VBA till you close admin windows. Press [enter] when ready"" & taskkill /f /im ""cmd.exe"") || echo. ""dummy"">nul", 1, True
End If
End With
'------------------
Debug.Print "-end-"
'------------------
End Sub
What you are doing should work. Here is a helper I have used.
Private Sub RunAsAdmin(ByVal command As String, ByVal parameters As String)
ShellExecute 0, "runas", command, parameters, vbNullString, SW_SHOWNORMAL
End Sub
This vbsscript, compatable with VBA, runs a verb from right click menu on a file. Programs have RunAs to elevate to admins on their menus.
HelpMsg = vbcrlf & " ShVerb" & vbcrlf & vbcrlf & " David Candy 2014" & vbcrlf & vbcrlf & " Lists or runs an explorer verb (right click menu) on a file or folder" & vbcrlf & vbcrlf & " ShVerb <filename> [verb]" & vbcrlf & vbcrlf & " Used without a verb it lists the verbs available for the file or folder" & vbcrlf & vbcrlf
HelpMsg = HelpMsg & " The program lists most verbs but only ones above the first separator" & vbcrlf & " of the menu work when used this way" & vbcrlf & vbcrlf
HelpMsg = HelpMsg & " The Properties verb can be used. However the program has to keep running" & vbcrlf & " to hold the properties dialog open. It keeps running by displaying" & vbcrlf & " a message box."
Set objShell = CreateObject("Shell.Application")
Set Ag = WScript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
If Ag.count = 0 then
wscript.echo " ShVerb - No file specified"
wscript.echo HelpMsg
wscript.quit
Else If Ag.count = 1 then
If LCase(Replace(Ag(0),"-", "/")) = "/h" or Replace(Ag(0),"-", "/") = "/?" then
wscript.echo HelpMsg
wscript.quit
End If
ElseIf Ag.count > 2 then
wscript.echo vbcrlf & " ShVerb - To many parameters" & vbcrlf & " Use quotes around filenames and verbs containing spaces" & vbcrlf
wscript.echo HelpMsg
wscript.quit
End If
If fso.DriveExists(Ag(0)) = True then
Set objFolder = objShell.Namespace(fso.GetFileName(Ag(0)))
' Set objFolderItem = objFolder.ParseName(fso.GetFileName(Ag(0)))
Set objFolderItem = objFolder.self
msgbox ag(0)
ElseIf fso.FolderExists(Ag(0)) = True then
Set objFolder = objShell.Namespace(fso.GetParentFolderName(Ag(0)))
Set objFolderItem = objFolder.ParseName(fso.GetFileName(Ag(0)))
ElseIf fso.fileExists(Ag(0)) = True then
Set objFolder = objShell.Namespace(fso.GetParentFolderName(Ag(0)))
Set objFolderItem = objFolder.ParseName(fso.GetFileName(Ag(0)))
Else
wscript.echo " ShVerb - " & Ag(0) & " not found"
wscript.echo HelpMsg
wscript.quit
End If
Set objVerbs = objFolderItem.Verbs
'If only one argument list verbs for that item
If Ag.count = 1 then
For Each cmd in objFolderItem.Verbs
If len(cmd) <> 0 then CmdList = CmdList & vbcrlf & replace(cmd.name, "&", "")
Next
wscript.echo mid(CmdList, 2)
'If two arguments do verbs for that item
ElseIf Ag.count = 2 then
For Each cmd in objFolderItem.Verbs
If lcase(replace(cmd, "&", "")) = LCase(Ag(1)) then
wscript.echo(Cmd.doit)
Exit For
End If
Next
'Properties is special cased. Script has to stay running for Properties dialog to show.
If Lcase(Ag(1)) = "properties" then
WSHShell.AppActivate(ObjFolderItem.Name & " Properties")
msgbox "This message box has to stay open to keep the " & ObjFolderItem.Name & " Properties dialog open."
End If
End If
End If

Email Terminal Shortcut

I need to change this VBA code for class. I'm looking at this tutorial http://spreadsheetpage.com/index.php/tip/sending_personalized_email_from_excel/ and instead of Outlook, I want to use Apple Mail stmp["mailto:"] functions directly from excel. I have the subject and message portion down, but all I want to know if I can run this script directly from terminal if we save this properly? And also can you annotate where I need to make specific changes pertaining to my email.
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 4 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)
' Message subject
Subj = "Your Annual Bonus"
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that your annual bonus is "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"
' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next r
End Sub
In Windows, you can save a VBA application as a .vbs file and run it from the command prompt or from Windows Explorer. There might be errors, if you have Excel specific functions, or if the VB versions aren't the same, but in general it will run.

Send Raw Data to ZPL Printer using Visual Basic (MS Access 2000)

This is all that I can find, none of them work.
Option Compare Database
Option Explicit
Private Type DOCINFO
pDocName As String
pOutputFile As String
pDatatype As String
End Type
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _
"StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pDocInfo As DOCINFO) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _
pcWritten As Long) As Long
Private Sub TEST()
Dim lhPrinter As Long
Dim lReturn As Long
Dim lpcWritten As Long
Dim lDoc As Long
Dim sWrittenData As String
Dim MyDocInfo As DOCINFO
lReturn = OpenPrinter("ZDesigner LP 2844", lhPrinter, 0)
If lReturn = 0 Then
MsgBox "The Printer Name you typed wasn't recognized."
Exit Sub
End If
MyDocInfo.pDocName = "AAAAAA"
MyDocInfo.pOutputFile = vbNullString
MyDocInfo.pDatatype = vbNullString
lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo)
Call StartPagePrinter(lhPrinter)
sWrittenData = "N" & vbFormFeed
sWrittenData = sWrittenData & "q609" & vbFormFeed
sWrittenData = sWrittenData & "Q203,26" & vbFormFeed
sWrittenData = sWrittenData & "B26,26,0,UA0,2,2,152,B," & Chr(34) & "603679025109" & Chr(34) & vbFormFeed
sWrittenData = sWrittenData & "A253,26,0,3,1,1,N," & Chr(34) & "SKU 6205518 MFG 6354" & Chr(34) & vbFormFeed
sWrittenData = sWrittenData & "A253,56,0,3,1,1,N," & Chr(34) & "2XIST TROPICAL BEACH" & Chr(34) & vbFormFeed
sWrittenData = sWrittenData & "A253,86,0,3,1,1,N," & Chr(34) & "STRIPE SQUARE CUT TRUNK" & Chr(34) & vbFormFeed
sWrittenData = sWrittenData & "A253,116,0,3,1,1,N," & Chr(34) & "BRICK" & Chr(34) & vbFormFeed
sWrittenData = sWrittenData & "A253,146,0,3,1,1,N," & Chr(34) & "X-LARGE" & Chr(34) & vbFormFeed
sWrittenData = sWrittenData & "P1,1" & vbFormFeed
lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, _
Len(sWrittenData), lpcWritten)
lReturn = EndPagePrinter(lhPrinter)
lReturn = EndDocPrinter(lhPrinter)
lReturn = ClosePrinter(lhPrinter)
End Sub
Method 2
Option Compare Database
Private Sub crtLabel()
Dim prtDevice As String
Dim strQuote As String
strQuote = Chr(34)
prtDevice = "ZDesigner LP 2844" ' whatever device Access currently has as the default. I have the user select a printer prior to printing, which sets the Access defaut printer
' open printer port
Open prtDevice For Output As #1
' initialize printer
Print #1, "OD" & vbCrLf
Print #1, "N" & vbCrLf
Print #1, "O" & vbCrLf
Print #1, "Q545,B12+23" & vbCrLf
Print #1, "q262" & vbCrLf
Print #1, "UN" & vbCrLf
Print #1, "rN" & vbCrLf
Print #1, "N" & vbCrLf
Print #1, "A4,94,3,3,1,1,N," & strQuote & "1803" & strQuote & vbCrLf
Print #1, "A36,74,3,3,1,1,N," & strQuote & "B" & strQuote & vbCrLf
Print #1, "A64,94,3,3,1,1,N," & strQuote & "079" & strQuote & vbCrLf
Print #1, "A112,8,0,2,1,1,N," & strQuote & strQuote & vbCrLf ' you can replace any string like "1803" with a string variable like SID or AID that gets passed to the sub
Print #1, "A112,32,0,3,1,1,N," & strQuote & strQuote & vbCrLf ' same here
Print #1, "A112,64,0,1,1,1,N," & strQuote & "04/13/2009" & strQuote & vbCrLf
Print #1, "A130,100,0,1,1,1,N," & strQuote & "SWAB, NASO" & strQuote & vbCrLf
Print #1, "A4,100,0,1,1,1,N," & strQuote & "C146536" & strQuote & vbCrLf
Print #1, "B53,130,0,1,1,0,47,N," & strQuote & "2009-06868" & strQuote & vbCrLf
Print #1, "A112,188,0,1,1,1,N," & strQuote & "" & strQuote & vbCrLf
Print #1, "P1,1" & vbCrLf
Print #1, "O" & vbCrLf
' close printer port
Close #1
End Sub
Nothing happens after running the function. It's like the printer is not touched at all by the code.
UPDATE
Method 1 is the closest thing I can get to printing the file. After executing the command, there is a printer icon at the status bar show that the printer has been called and receiving data from my code, but still, no printing at all. Help...
if it is mapped to a parallel or com port, you can open that directly:
open "LPT1:" For Output as #1
' or open "COM1:"
print #1, "SomeData"
Close #1
What I like to do is do something similar to your Method 2, but save it to a file (the raw printer data) and then do a file copy to the UNC path.
file copy "C:\label.txt" \computername\sharename
That works for me.
Okay so this is how I managed to get thing this work. Not a best option as I wanted but ... it works.
1) I use the same function, but written in C++, taken from here http://support.microsoft.com/kb/138594/EN-US
// RawDataToPrinter - sends binary data directly to a printer
//
// Params:
// szPrinterName - NULL terminated string specifying printer name
// lpData - Pointer to raw data bytes
// dwCount - Length of lpData in bytes
//
// Returns: TRUE for success, FALSE for failure.
//
BOOL RawDataToPrinter(LPSTR szPrinterName, LPBYTE lpData, DWORD dwCount)
{
HANDLE hPrinter;
DOC_INFO_1 DocInfo;
DWORD dwJob;
DWORD dwBytesWritten;
// Need a handle to the printer.
if( ! OpenPrinter( szPrinterName, &hPrinter, NULL ) )
return FALSE;
// Fill in the structure with info about this "document."
DocInfo.pDocName = "My Document";
DocInfo.pOutputFile = NULL;
DocInfo.pDatatype = "RAW";
// Inform the spooler the document is beginning.
if( (dwJob = StartDocPrinter( hPrinter, 1, (LPSTR)&DocInfo )) == 0 )
{
ClosePrinter( hPrinter );
return FALSE;
}
// Start a page.
if( ! StartPagePrinter( hPrinter ) )
{
EndDocPrinter( hPrinter );
ClosePrinter( hPrinter );
return FALSE;
}
// Send the data to the printer.
if( ! WritePrinter( hPrinter, lpData, dwCount, &dwBytesWritten ) )
{
EndPagePrinter( hPrinter );
EndDocPrinter( hPrinter );
ClosePrinter( hPrinter );
return FALSE;
}
// End the page.
if( ! EndPagePrinter( hPrinter ) )
{
EndDocPrinter( hPrinter );
ClosePrinter( hPrinter );
return FALSE;
}
// Inform the spooler that the document is ending.
if( ! EndDocPrinter( hPrinter ) )
{
ClosePrinter( hPrinter );
return FALSE;
}
// Tidy up the printer handle.
ClosePrinter( hPrinter );
// Check to see if correct number of bytes were written.
if( dwBytesWritten != dwCount )
return FALSE;
return TRUE;
}
I got the file RAWPRN.EXE from there, put my EPL code in a txt file. Finally, use Shell to execute it
Dim RetVal
RetVal = Shell("cmd .exe /c C:\rawprint\RawPrint.exe ""ZDesigner LP 2844"" ""C:\eplcode.txt""", 1)
My solution for Zebra
Creating a generic/text printer in windows then sending to raw file to this printer
In Zebra printers advanced settings --> others,
there is a passthrough characters. You can send raw text with this to this printer.
I use this solution, works perfect.
make a generic text printer, following this recipe
Map the printer to LPT1, using "net use lpt1 \\computername\printername /persistent:yes
Send files to the printer, using:
VBA
Public function runCmd(cmd as String) as Boolean
Dim wsh As Object
Dim cmdToRun As String
Dim Sts As Integer
Set wsh = VBA.CreateObject("WScript.Shell")
cmdToRun = "cmd.exe /c " & Quote(cmd)
'Run & wait to complete
Sts = wsh.Run(cmdToRun, 0, 1)
If Sts = 0 Then
runCmd = True
Else
MsgBox cmd & vbCrLf & "Failed with error code " & Sts
End If
Set wsh = Nothing
End Function
Using cmd : : "cd {dir} & Print \D:LPT1 [file [file]]"