I have macro running in an Excel sheet. However am getting the error file not found but the files are in the specified directory. See the below code and not sure what we are missing. The error happens when calling SQLLDR .
Shell ("SQLLDR USERID= srvmacro/srvmacroswazi#pn81.world CONTROL=" & outfile & " LOG=" & outfile & ".LOG")
'Shell ("SQLLDR USERID= srvmacro/srvmacroswazi#pn81.world CONTROL=" & outfile & " LOG=" & outfile & ".LOG")
MsgBox " Done all "
End If
'Unload UserForm1
End Sub
Most likely is that you have a space (or other special character in your outfile variable
try the following to see what you are actually trying to execute...
msgbox "SQLLDR USERID=srvmacro/srvmacroswazi#pn81.world CONTROL=" & outfile & ", LOG=" & outfile & ".LOG"
It should probably be more like: -
shell ("SQLLDR USERID=srvmacro/srvmacroswazi#pn81.world CONTROL=""" & outfile & """, LOG=""" & outfile & ".LOG""")
Note the escaped quotes and you are also missing a comma between the keywords
Related
I have a text file that I would like to add a header and a footer to. I don't want to overwrite the first or last lines, rather I'd like to add a new first line and append a line to the end of the file.
The below Function works for appending to the bottom of the file but I'd like to be able to control where the line is inserted. Thank you!
Function WriteToText(sFile As String, sText As String)
On Error GoTo Err_Handler
Dim iFileNumber As Integer
iFileNumber = FreeFile ' Get unused file number
Open sFile For Append As #iFileNumber ' Connect to the file
Print #iFileNumber, sText ' Append our string
Close #iFileNumber ' Close the file Exit_Err_Handler:
Exit Function Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Txt_Append" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler End Function
What you do for a task like this:
Read the whole file into a string (Open For Input)
Add the data you want: S = "header line" & vbCrLf & S & vbCrLf & "footer line"
Write the whole string to the file, overwriting it (Open For Output)
I have a file which I need to FTP using VBA and I have figured most part of it except last one where I need to insert " in the file name but not able to do.
csvPath = "C:\Users\10613527\Desktop\test\"
sWorkingDirectory = csvPath
sFileToSend = "Price_Change_10-08-15 20-35-49.csv"
iFreeFile = FreeFile
Open sWorkingDirectory & FTP_BATCH_FILE_NAME For Output As #iFreeFile
Print #iFreeFile, "open " & FTP_ADDRESS
Print #iFreeFile, FTP_USERID
Print #iFreeFile, FTP_PASSWORD
Print #iFreeFile, "ASCII"
Print #iFreeFile, "put " & sWorkingDirectory & sFileToSend
Print #iFreeFile, "dir"
Close #iFreeFile
'Shell command the FTP file to the server
Shell "ftp -i -w:20480 -s:" & sWorkingDirectory & FTP_BATCH_FILE_NAME
In the above code , I get the error that the file is not found.
The reason is that the file path and name is not in "", for example this code is writing another script file and executing that one.
So it needs to be
open ftp path
username
password
ASCII
put "C:\Users\10613527\Desktop\test\Price_Change_10-08-15 20-35-49.csv"
dir
and not
open ftp path
username
password
ASCII
put C:\Users\10613527\Desktop\test\Price_Change_10-08-15 20-35-49.csv
dir
Notice the " " in the PUT statement, I have no idea how to place them there.
Use "" to escape " in a vb string.
So
Print #iFreeFile, "put """ & sWorkingDirectory & sFileToSend & """"
This is the header of my main function to write excel cells to an XML file. I want this to call another function, which can do its own set of writing.
Public Sub WriteXML()
Dim Sheet As Worksheet
Dim Cell As Range
Dim xmlFile
xmlFile = ThisWorkbook.Path & "\" & 'Test1' & ".xml"
Set Sheet = ActiveWorkbook.Worksheets("Sht1")
Open xmlFile For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & _
" encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
Call WriteCustomer(xmlFile)
This is the start of the second function, though I'm getting an 'object not found' sort of error.
Sub WriteCustomer(x As Variant)
Print x, " <Customer>"
Print x, " <First>" & 'Bill' & "</First>"
Print x, " <Last>" & 'Johnson' & "</Last>"
Print x, " </Customer>"
Print x, ""
End Sub
How do I need to construct the call and/or variable to pass the open file as an object to the second function?
You can request, store and pass around a handle as follows:
Dim handle As Integer
handle = FreeFile()
Open xmlFile For Output As #handle
Print #handle, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & _
...
Call WriteCustomer(handle)
And
Sub WriteCustomer(handle As Integer)
Print #handle, " <Customer>"
Since you have opened the file in the first function with the line
Open xmlFile For Output As #1
Any code that references #1 while it's open will write to the same file. Thus you can simply rewrite your second function as
Sub WriteCustomer()
Print #1, " <Customer>"
Print #1, " <First>" & 'Bill' & "</First>"
Print #1, " <Last>" & 'Johnson' & "</Last>"
Print #1, " </Customer>"
Print #1, ""
End Sub
Is there a way to open an MS-Access 2003 database from the command line without running any of the startup vba code or displaying any errors?
I looked at the command line arguments for MS Access and there doesn't seem to be one for specifying that you want none of the vba code to execute on startup.
I'm using the following code to open up a database in a separate vba database:
Sub test()
Dim accObj As Access.application, Msg As String
Dim application As String, dbs As String, workgroup As String
Dim user As String, password As String, cTries As Integer
Dim x
Dim theDB As Database
' This is the default location of Access
application = "C:\Program Files (x86)\Microsoft Office\OFFICE11\MSACCESS.EXE"
' Use the path and name of a secured MDB on your system
dbs = "C:\ucpdatas\awashic-pc\APLReporting.mdb"
' This is the default working group
workgroup = "E:\Tickets\CSN_NotSure\Secured.mdw"
user = "aleer"
password = "****"
Debug.Print application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & " /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus
x = Shell(application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & " /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus)
On Error GoTo WAITFORACCESS
Set accObj = GetObject(, "Access.Application")
' Turn off error handling
On Error GoTo 0
' You an now use the accObj reference to automate Access
Debug.Print "Access is now open."
' Do Stuff...
accObj.CloseCurrentDatabase
accObj.Quit
' Close it out...
Set accObj = Nothing
Debug.Print "Closed and complete."
Exit Sub
WAITFORACCESS: ' <--- this line must be left-aligned.
' Access isn't registered in the Running Object Table yet, so call
' SetFocus to take focus from Access, wait half a second, and try again.
' If you try five times and fail, then something has probably gone wrong,
' so warn the user and exit.
'SetFocus
If cTries < 5 Then
cTries = cTries + 1
Sleep 500 ' wait 1/2 seconds
Resume
Else
Debug.Print "It didn't work"
End If
End Sub
This line...
x = Shell(application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & " /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus)
Turns out to be...
C:\Program Files (x86)\Microsoft Office\OFFICE11\MSACCESS.EXE "C:\ucpdatas\awashic-pc\APLReporting.mdb" /nostartup /user aleer /pwd *** /wrkgrp "E:\Tickets\CSN_NotSure\Secured.mdw" 2
... at the command line.
But when the database opens it executes a bunch of vba codes and displays error messages.
There is no way for Access to open without running the AutoExec macro associated with that database. The only solution would be to have the AutoExec contain conditional arguments that determined how the database was opened, and not run the commands if the database was shell'd. This would require editing every database to include this logic.
Technically, yes there is a way to open an MS-Access 2003 database from the command line without running any of the startup macros, although it does not involve the command line arguments: If you hold down the Shift key while the database opens, it will not run the AutoExec script (and suppresses a few other things). This also assumes the AllowBypassKey property has not been set to False.
See Ignore startup options
I'm trying to move my entire User folder in Vista to a non-system partition. To do so with a minimum hassle I'm following the directions provided at Ben's Blog, specifically the vbs script he provides. However executing the script throws up an error which I can't resolve myself. Here's the vbs code followed by the text file it calls on, and finally my error message. Can someone help me correct the problem? (I really don't know much about VBS, so please write as simple as possible.)
VBS Code:
'# Perform dir /a c:\users > c:\dir.txt
'# place this script file in c:\ too
'# double click to run it
'# run resulting script.bat from recovery mode
repprefix = " Directory of..." ' Modify to your language
sourcedrive = "C:\"
targetdrive = "D:\"
altsourcedrive = "C:\" 'leave same as target drive unless otherwise indicated
alttargetdrive = "E:\" 'leave same as target drive unless otherwise indicated
inname = "dir.txt"
outname = "script.bat"
userroot = "Users"
set fso = CreateObject("Scripting.FileSystemObject")
' construct batch commands for saving rights, then link, the recreating rights
Function GetCommand(curroot, line, typ, keyword)
' first need to get source and target
pos = Instr(line, keyword) + Len(keyword)
tuple = Trim(Mid(line, pos))
arr = Split(tuple, "[")
oldtarget = Replace(arr(1), "]", "")
oldlink = curroot & "\" & Trim(arr(0))
' need to determine if we are pointing back to old disk
newlink = replace(oldlink, sourcedrive, targetdrive)
if(Instr(oldtarget, sourcedrive & userroot)) then
newtarget = Replace(oldtarget, sourcedrive, targetdrive)
else
newtarget = oldtarget ' still pointing to original target
end if
' comment
out = "echo " & newlink & " --- " & newtarget & vbCrLf
' save permissions
out = out & "icacls """ & replace(oldlink, sourcedrive, altsourcedrive) & """ /L /save " & altsourcedrive & "permissions.txt" & vbCrLf
' create link
newlink = replace(newlink, targetdrive, alttargetdrive)
if typ = "junction" then
out = out & "mklink /j """ & newlink & """ """ & newtarget & """" & vbCrLf
else ' typ = "symlink"
out = out & "mklink /d """ & newlink & """ """ & newtarget & """" & vbCrLf
end if
'set hidden attribute
out = out & "attrib +h """ & newlink & """ /L" & vbCrLf
' apply permissions
shortlink = Left(newlink, InstrRev(newlink, "\") - 1) 'icacls works strangely - non-orthogonal for restore
out = out & "icacls """ & shortlink & """ /L /restore " & altsourcedrive & "permissions.txt" & vbCrLf
GetCommand = out & vbCrLf
End Function
Sub WriteToFile(file, text)
ForWriting = 2
Create = true
set outfile = fso.OpenTextFile(file, ForWriting, Create)
Call outfile.Write(text)
Call outfile.Close()
End Sub
outtext = "ROBOCOPY " & altsourcedrive & userroot & " " & alttargetdrive & userroot & " /E /COPYALL /XJ" & vbCrLf & vbCrLf
set intext = fso.OpenTextFile(inname)
while not intext.AtEndOfStream
line = intext.ReadLine()
if Instr(line, repprefix) then
curroot = Replace(line, repprefix, "")
elseif Instr(line, juncname) then
outtext = outtext & GetCommand(curroot, line, "junction", juncname)
elseif Instr(line, linkname) then
outtext = outtext & GetCommand(curroot, line, "symlink", linkname)
end if
Wend
outtext = outtext & "icacls " & altsourcedrive & userroot & " /L /save " & altsourcedrive & "permissions.txt" & vbCrLf
outtext = outtext & "ren " & altsourcedrive & userroot & " _" & userroot & vbCrLf
outtext = outtext & "mklink /j " & altsourcedrive & userroot & " " & targetdrive & userroot & vbCrLf
outtext = outtext & "icacls " & altsourcedrive & " /L /restore " & altsourcedrive & "permissions.txt"
Call intext.Close()
Call WriteToFile(outname, outtext)
MsgBox("Done writing to " & outname)
dir.txt:
Volume in drive C is ACER
Volume Serial Number is 08D7-C0CC
Directory of c:\users
07/16/2009 12:29 PM <DIR
07/16/2009 12:29 PM <DIR> ..
11/02/2006 09:02 AM <SYMLINKD> All Users [C:\ProgramData]
11/02/2006 09:02 AM <DIR> Default
11/02/2006 09:02 AM <JUNCTION> Default User [C:\Users\Default]
08/21/2008 08:37 AM 174 desktop.ini
11/02/2006 08:50 AM <DIR> Public
07/19/2009 08:54 PM <DIR> Steve
1 File(s) 174 bytes
7 Dir(s) 5,679,947,776 bytes free
Error Message:
Windows Script Host
Script: C:\userlocationchange.vbs
Line: 25
Char: 2
Error: Subscript out of range: '[number: 1]'
Code: 800A0009
Source: Microsoft VBScript runtime error
The problem is at these lines:
arr = Split(tuple, "[")
oldtarget = Replace(arr(1), "]", "")
I assume that arr(1) is giving the error because arr has only one entry - and since arrays are zero-based in VBS, that entry should be accessed as arr(0).
Hmmm... if there's only one entry, then presumably no "[" was found. The code probably needs to check for that (by testing whether UBound(arr) > 1).
What that means in a wider context - i.e. why there's no "[" I can't say.
EDIT: OK, I took a look at the blog you referred to, and the exact same problem was reported. The blog author replied:
A couple of pointers: look in the txt
file output by the dir command. On my
system, the targets of the symlinks
are shown in square brackets [].
Apparently in your case there aren't
any - in any case that is a hypothesis
that would explain why the script
can't parse out the link targets.
...which pretty much confirms my theory. I suggest you do as he suggests and take a look at the txt file to see if some other character is used.
Note that this isn't really a problem with the script per se - it's just that the script expects some input that it's not getting.
#Gary, I'm the same one who reported the problem on that blog.
I posted the txt file here under the VBS code. My txt file also has the symlink-junction targets within square brackets. Is there anything else I'm missing?