I do not understand where "Flag and Err05" (at the bottom of the codes)have been declared ? I have searched the entire project and can not found where the two parameters got declared. When I try to use the below codes in another project , i got the error message "Run time error : items not found in this collection " Any answers?
>Private Sub SanityCheck_Click()
>Dim St As String, WrnFlag As Boolean, j As Integer
>Dim RS As Recordset, RS1 As Recordset, i As Integer, WrongRootCauses As String
>Dim Err01 As String, Err02 As String, Err03 As String, Err04 As String
>WrnFlag = False
>If IsNull(Me.FactoryList) Then
> MsgBox "Select valid Factory before proceeding.", vbExclamation
>Else
> St = "SELECT Factory, Step1, Step2, Step3, Step4, DateColumn FROM [tbl >Factory] WHERE Allowed = True and Factory = """ & Me.FactoryList.Value & """"
> Set RS = CurrentDb.OpenRecordset(St, dbOpenSnapshot)
'-- 12NC codes check --
> St = "SELECT Count([" & RS!Step2 & "].PLANT) AS 12NC_chk " & _
>"FROM [" & RS!Step2 & "] " & _
> "WHERE (((Len(Trim(IIf(Left(Trim([12NC_CODE]),3)=""000"",Right>([12NC_CODE],Len([12NC_CODE])-3),[12NC_CODE])))) Not In (0,1,12)));"
' "WHERE (((Len(Trim([12NC_CODE]))) Not In (0,1,12)));"
> Set RS1 = CurrentDb.OpenRecordset(St, dbOpenSnapshot)
>If RS1.BOF And RS1.EOF Then
> Err05 = "+ No 12NC issues found."
>Else
> RS1.MoveFirst
> RS1.MoveLast
> If RS1![12NC_chk] = 0 Then
> Err05 = "+ No 12NC issues found."
> Else
> Err05 = "- " & RS1![12NC_chk] & " Incorrect 12NCs found!"
> WrnFlag = True
> End If
> End If
'--
> If WrnFlag = True Then **Flag** = vbCritical Else **Flag** = vbInformation
> MsgBox RS!Factory & " input data sanity check:" & vbCrLf & vbCrLf & " " & >Err01 & vbCrLf & " " & Err02 & vbCrLf & " " & Err03 & _
> vbCrLf & " " & Err04 & vbCrLf & " " & Err05 & vbCrLf & vbCrLf & IIf>>(WrongRootCauses = "", "", " Unknown ADP Root Cause(s):" & vbCrLf & WrongRootCauses), Flag
> RS.Close
>RS1.Close
>End If
>End Sub
Two posibilities
Unless the file have Option explicit in the top, you are not forced to explicitely declare variables. Which means that Flag and Err05 have indeed never been declared. VBA will just create them on the fly with a Variant type and an initial value of Nothing.
They might be global variables declared outside of any sub in another file. Try right clicking the variable and then click definition in the menu, Access will show you the way.
Related
The codes purpose is to 'build' the correct name style for each record in a CDSal and FormatName field. I have a group of tables (all linked) with individuals Full Name(NewName), Salutation, First, Middle and Last Name, as well as Client defaults for what to do with those names (!NewName, !First, !AA, etc.).
The Recordset is pulled from a query in the database that brings some necessary fields together from 2 different tables. From Access I can open the query, make any changes needed to any of the fields, save the record and see the changes reflected in the underlying tables. When I run the following code, the Debug.Print's produce the expected outcomes but nothing is permanently saved to the tables. The code never errors (which might be part of the problem) and for Case "!AA" both CDSal and FormatName fields are filled with !NewName when Debug.Print again shows the expected outcome. Case "!AA" is the only instance where anything is actually changed on the tables.
I have attempted everything that I could find on the Internet to troubleshoot this error as well as multiple different configurations to get something to "stick". Hopefully it is a simple answer, let me know what you all think.
Private Sub Form_Load()
On Error GoTo Form_Load_Err
'_ SetUp Variables _'
Dim strQry As String, strSQL As String, strName As String
Dim rstName As DAO.Recordset
'_ Declare Variables _'
strQry = "MyQueryName"
Set rstName = CurrentDb.OpenRecordset(strQry, dbOpenDynaset)
'_ Begin Code _'
With rstName
If Not (.EOF And .BOF) Then .MoveFirst
Do Until .EOF = True
'Update CDSal with correct Naming Information
Debug.Print !NewName
.Edit
Select Case !CDSal_Client
Case "NewName" 'Clients that use NewName for blah
!CDSal = !NewName
Case "First" 'Clients that use First for blah
!CDSal = !First
Case "AA" 'ClientName: CDSal = First, FormatName = NewName(w/o Sal)
!CDSal = !First
If !Sal <> "" Then
!FormatName = !First & " " & !Middle & " " & !Last
Else
!FormatName = !NewName
End If
Case "BB" 'ClientName: Client uses specific breakdown for names
If !Sal <> "" And !Last <> "" Then
!CDSal = !Sal & " " & !Last
!FormatName = !Sal & " " & !Last
ElseIf !First <> "" And !Last <> "" Then
!CDSal = !First & " " & !Last
!FormatName = !First & " " & !Last
ElseIf !First <> "" Then
!CDSal = !First
!FormatName = !First
Else
!CDSal = "Valued Member"
!FormatName = "Valued Member"
End If
Case "CC" 'ClientName: CDSal = NewName(trim " & " if needed) = NewName + AddlName(done on import)
If Right(!NewName, 3) = " & " Then
Replace !NewName, " & ", ""
!CDSal = !NewName
Else
!CDSal = !NewName
End If
End Select
.Update
Debug.Print !CDSal
Debug.Print !FormatName
.MoveNext
Loop
'Removes additional spaces left over from concatenating fields
strSQL = "UPDATE [" & strQry & "] SET [FormatName] = REPLACE(REPLACE(REPLACE([FormatName],' ','<>'),'><',''),'<>',' '), " & _
"[CDSal] = REPLACE(REPLACE(REPLACE([FormatName],' ','<>'),'><',''),'<>',' ');"
CurrentDb.Execute strSQL
End With
'_ Error Handling & CleanUp
Form_Load_ClnUp:
rstName.Close
Set rstName = Nothing
Exit Sub
Form_Load_Err:
MsgBox Err.SOURCE & " : " & Err.Number & vbCr & _
"Error Description : " & Err.Description
GoTo Form_Load_ClnUp
End Sub
MyQueryName SQL
SELECT T_Individual.ID_IndivRecords, T_Individual.NewName, T_Individual.NewName2, T_Individual.CDSal, T_Individual.FormatName, T_Individual.Status_, T_Individual.Sal, T_Individual.First, T_Individual.Middle, T_Individual.Last, T_Clients.ID_Client, T_Clients.CDSal_Client, T_Individual.Date
FROM T_Individual INNER JOIN (T_Clients INNER JOIN (T_Jobs INNER JOIN T_IndivJobs ON T_Jobs.ID_Jobs = T_Individual.Jobs) ON T_Clients.ID_Client = T_Jobs.Client) ON T_Individual.ID_IndivRecords = T_IndivJobs.ID_DonorRecords
WHERE (((T_Individual.Date)=Date()));
strSQL = "UPDATE [" & strQry & "] SET [FormatName] = REPLACE(REPLACE(REPLACE([FormatName],' ','<>'),'><',''),'<>',' '), " & _
"[CDSal] = REPLACE(REPLACE(REPLACE([FormatName],' ','<>'),'><',''),'<>',' ');"
Another instance of a simple error and or mistype can drastically affect everything you are trying to achieve. This SQL was ran after the code was processed to remove any double spaces that might have been in the original data or created from concatenation. Notice that the CDSal field will be replaced with the FormatName field in the last line instead of being replaced with itself. Since most records do not use the FormatName field their CDSal field was getting replaced with NULL . . .
I have corrected this issue and everything runs very smoothly and correctly now.
Thanks for everyone who tried to help on this! Any additional information on Formatting or Optimization is always appreciated.
I have tried this every different way, and it was working yesterday, so I really don't know what changed.
I import a spreadsheet to a temp table in an Access app. Then I set that to be the dao.recordset, and start looping through. I check for the ID to not be null and if not go through checking fields for values, and updating as appropriate. the minute I hit a null, I get a system error "94 - invalid use of null"
It doesn't offer a debug, but I have debugs throughout my code, so I can see where it fails. It fails when I do this check: If IsNull(rstImportCList("columnx")) = False Then
I have tried nz(rstImportCList("columnx"),"") <> "" I have tried rstImportCList("columnx") is not null, and everything else I can think of. Why is the check that is supposed to prevent this error, causing this error?
Edit:
This is the beginning where I declare the recordset I can't get past doing anything with the recordset field.
Dim db As DAO.Database
Dim rstImportCList As DAO.Recordset
Dim RSsql As String
Set db = CurrentDb()
RSsql = "Select * from tblTempImportCList"
Set rstImportCList = db.OpenRecordset(RSsql)
If rstImportCList.EOF Then Exit Sub
Do While Not rstImportCList.EOF
whether I try to check
IsNull(rstImportCList("xyz").Value) = False
or
nz(rstImportCList("xyz").Value,"") <> ""
or
dim x as string
x = rstImportCList!xyz.value
I get the same error 94 invalid use of null.
Any idea why this is?
--edit with more code.
I took some time to take a the beginning and some of each section of the code, so I could make it generic and see if anyone can help. Here is what I am working on. The Code1 and Code2 parts don't seem to be the issue. Sometimes it fails on a null value in a Yes/No column (I'm just looking for Y but the value is null), sometimes on the notes being null. It's not consistent, which is why I'm having a hard time nailing down the issue.
Private Sub cmdImportList_Click()
On Error GoTo cmdImportExcel_Click_err:
Dim fdObj As FileDialog
Set fdObj = Application.FileDialog(msoFileDialogFilePicker)
Dim varfile As Variant
Dim importCT As Integer
Dim dbu As DAO.Database
Dim cBadXVal, cBadYVal As Integer
Dim preNotes As String
Dim RSsql As String
Dim uNotesql, uVal1sql, uVal2sql As String
Dim db As DAO.Database
Dim rstImportCList As DAO.Recordset
Dim CheckB4Import As Integer
CheckB4Import = MsgBox("Are you SURE the sheet you are importing has the following column names in the same order:" & vbCrLf & vbCrLf & _
"IDName/ First/ Mid/ Last/ Sfx/ Age/ Telephone/ Code1/ Code2/ YN1/ YN2/ NY3/ Notes/ AsYN1edTo" & vbCrLf & vbCrLf & _
"AND that there are NO empty rows or empty columns?" & vbCrLf & vbCrLf & _
"Click OK to proceed, Click CANCEL to go double-check your CallSheet before importing.", vbOKCancel, "WITH GREAT POWER COMES GREAT RESPONSIBILITY TO QC DATA")
If CheckB4Import = vbOK Then
CurrentDb.Execute "DELETE * FROM tblTempImportCList", dbFailOnError
With fdObj
'CAN ONLY SELECT 1 FILE
.allowmultiselect = False
.Filters.Clear
.Filters.Add "Excel 2007+", "*.xlsx"
.Title = "Please select the completed list to import:"
.Show
If .SelectedItems.Count = 1 Then
varfile = .SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, , "tblTempImportCList", varfile, True, "Sheet1!"
cBadXVal = DLookup("BadXCount", "qryImpCheckBadXVal")
Debug.Print "cBadXVal - " & cBadXVal
If cBadXVal <> 0 Then
DoCmd.OpenForm "frmImportError", acNormal
Forms!frmImportError.Form.lblErrorMsg.Caption = _
"Oh No! Your list import failed!" & vbCrLf & _
cBadXVal & " X values are not valid." & vbCrLf & _
"Don't worry. You can fix your sheet and re-import!" & vbCrLf & _
"Would you like to open the documentation for the valid codes" & vbCrLf & _
"Or are you all set?"
End If
cBadYVal = DLookup("BadYCount", "qryImpCheckBadYVal")
Debug.Print "cBadYVal - " & cBadYVal
If cBadYVal <> 0 Then
DoCmd.OpenForm "frmImportError", acNormal
Forms!frmImportError.Form.lblErrorMsg.Caption = _
"Oh No! Your list import failed!" & vbCrLf & _
cBadYVal & " YN1 values are not valid." & vbCrLf & _
"Don't worry. You can fix your sheet and re-import!" & vbCrLf & _
"Would you like to open the documentation for the valid codes" & vbCrLf & _
"Or are you all set?"
Exit Sub
End If
Else
MsgBox "No file was selected. Try again!", vbCritical, "Uh-oh Spaghettios!"
End If
End With
'PASSED CHECKS
Set db = CurrentDb()
RSsql = "Select * from tblTempImportCList"
Set rstImportCList = db.OpenRecordset(RSsql)
If rstImportCList.EOF Then Exit Sub
Debug.Print "got here"
Do While Not rstImportCList.EOF
Debug.Print "Start Processing: " & Nz(rstImportCList("IDName").Value, "")
'GET NOTES ALREADY ON RECORD
If Nz(rstImportCList("IDName").Value, "") <> "" Then
Debug.Print "got past if IDName is not null"
If Nz(rstImportCList("Notes").Value, "") <> "" Then
Debug.Print "got past if notes is not null"
preNotes = Replace(Nz(DLookup("Notes", "tblVFileImport", "IDName = " & rstImportCList("IDName").Value), ""), """", "")
'UPDATE NOTES
If Nz(preNotes, "") <> "" Then
uNotesql = "Update tblVFileImport SET tblVFileImport.Notes = '" & preNotes & "; " & Replace(Nz(rstImportCList("Notes").Value, ""), """", "") & "' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName").Value
'debug.print "Notes"
'debug.print "uNotesql - " & uNotesql
Else
uNotesql = "Update tblVFileImport SET tblVFileImport.Notes = '" & Replace(Nz(rstImportCList("Notes").Value, ""), """", "") & "' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName").Value
End If
RunMySql (uNotesql)
'DoCmd.RunSQL (uNotesql), dbFailOnError
End If
If Nz(rstImportCList("YN1").Value, "") = "Y" Then
'UPDATE YN1
uYN1sql = "Update tblVFileImport SET tblVFileImport.YN1 = '" & rstImportCList("YN1") & "', tblVFileImport.callprocessed = 'Y' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "YN1 = Y or y"
Debug.Print "uYN1sql - " & uYN1sql
RunMySql (uYN1sql)
'DoCmd.RunSQL (uYN1sql), dbFailOnError
End If
If Nz(rstImportCList("YN2").Value, "") = "Y" Then
'UPDATE YN2
uYN2sql = "Update tblVFileImport SET tblVFileImport.YN2 = '" & rstImportCList("YN2") & "', tblVFileImport.callprocessed = 'Y' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "YN2 = Y or y"
Debug.Print "uYN2sql - " & uYN2sql
RunMySql (uYN2sql)
'DoCmd.RunSQL (uYN2sql), dbFailOnError
End If
'START Code1 PROCESSING
If Nz(rstImportCList("Code1").Value, "") <> "" Then
'Code1 Case abc
vdispo = DLookup("Code1", "tblvFileImport", "IDName = " & rstImportCList("IDName"))
If rstImportCList("Code1") = "ABC" Then
Debug.Print "Dispo Case ABC"
'DELETE RECORD
dMDsql = "DELETE from tblVFileImport " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "dMDsql - " & dMDsql
RunMySql (dMDsql)
'DoCmd.RunSQL (dMDsql), dbFailOnError
'Code1 Case DEF OR GHI OR JKL
ElseIf Nz(rstImportCList("Code1"), "") = "DEF" Or Nz(rstImportCList("Code1"), "") = "GHI" Or Nz(rstImportCList("Code1"), "") = "JKL" Then
Debug.Print "Dispo Case DEF OR GHI OR JKL "
'IF DEF
If rstImportCList("Code1") = "DEF" Then
'IF CELL SAME - UPDATE NULL
ccellsame = DLookup("IDName", "tblVFileImport", "IDName = " & rstImportCList("IDName") & " AND nz(Cell,'') = Phone ")
If ccellsame = rstImportCList("IDName") Then
uCellsql = "Update tblVFileImport SET tblVFileImport.Cell = NULL, tblVFileImport.CellString = NULL, tblVFileImport.mobileflag = NULL " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "uCellsql - " & uCellsql
RunMySql (uCellsql)
'DoCmd.RunSQL (uCellsql), dbFailOnError
End If
End If
End If
End If
End If
Debug.Print "End Processing: " & rstImportCList("IDName")
rstImportCList.MoveNext
Loop
Debug.Print "Finished Looping"
rstImportCList.Close
importCT = DCount("IDName", "tblTempImportCList")
MsgBox importCT & " Records imported for list.", vbOKOnly, "List Processed"
Else
MsgBox "Good Call. Check twice, import once!", vbOKOnly, "Better Safe Than Sorry"
End If
Exit Sub
cmdImportExcel_Click_err:
Select Case Err.Number
Case Else
Call MsgBox(Err.Number & " – " & Err.Description, vbCritical + vbOKOnly, "System Error …")
End Select
End Sub
Any suggestions are greatly appreciated. I'm 1/2 tempted to suck this into a SQL table and just execute a stored procedure. I can get it to work in there, I think.
If IsNull(rstImportCList("columnx").Value) Then
otherwise you're checking if the Field object itself is null.
https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/field-object-dao#:~:text=To%20refer%20to,Fields(%22name%22)
This is a case where relying on a default property (in this case Value) causes problems.
I want to be able to tell IF a form is the active window.
It seems simply invoking that method produces an error. I guess I could catch that error and run with it, but it's a backwards way of doing it.
Screen.ActiveForm.Name
This needs a form to be active. If I am breaking any rules of stackOverflow please be kind and remind me as I am new to forum.
Screen.parent, screen.activeControl, etc. What if VBA editor is open, as often it is?
Function CStatus(strStatus, ByRef intType As Integer, Optional ByRef erNo, Optional erMsg, Optional strDatum)
'pXname = "CStatus"
'pXStack = Left(pXStack, 500) & ">" & pXname
'Updates and manages the status bar
Dim strPreamble As String, strOut As String, strForm As String, strComment As String, strSQL As String, strPxStack As String, strCErrStack As String
Dim intColor As Double
Dim intPreLen As Integer
'On Error GoTo err_hand
'Color Codes
'12632256 = Lt Grey
'33023 = Orange
'65280 = Green
'16744576 = Steel Grey
'Define "Constants"
intPreLen = 350 'Length of previous message cache
'** Fix missings
If (IsMissing(strDatum) = True) Then strDatum = "[N/A]"
'** Other inits
strWindow = Screen.Parent.Name
strForm = Screen.ActiveForm.Name
'** intDebug ' Minimum Level of to report to status
'bEcho = True 'Whether to echo to status
intColor = errNoColor(intType)
'Error-level idiot explanations
strComment = "0"
If IsMissing(erNo) Then erNo = 0
If (IsNull(erMsg) = False) Then
If IsMissing(erMsg) = False Then strComment = erMsg
End If
strComment = errorTree(erNo)
strPreamble = Left(strPreamble, intPreLen) & "..."
strErrStack = Left(strErrStack, intPreLen) & " > " & pXname & ":" & intType
strCErrStack = strErrStack
reS:
If ((strForm = "finvmain") Or (strForm = "fclips")) Then Screen.ActiveForm.timeStatusUpdated = Now() 'Small field keeps time
If bEcho = True Then
strPxStack = ""
strCErrStack = "" 'Internal error stack
End If
strOut = Now() & " " & intType & " (" & strType & "): " & erNo & " " & strCErrStack & " >> " & strComment & " / " & strStatus & " [" & strDatum & "] .. " & strPreamble
If bEcho = True Then
If (strForm = "fInvMain") Then Screen.ActiveForm.txtStatus2 = Screen.ActiveForm.txtStatus 'Added second window to show previous message
Screen.ActiveForm.txtStatus = strOut
End If
Screen.ActiveForm.txtStatus.ForeColor = intColor
If strForm = "fInvMain" Then strTag = Screen.ActiveForm.Controls("txttag").value
'***Event Log
If erNo = "" Then erNo = 0
If IsMissing(erMsg) = True Then erMsg = ""
If IsMissing(strDatum) = True Then strDatum = ""
If Len(strPreamble) < 2 Then strPreamble = "[None]"
'Fixxed - Syntax Error for Some Odd Reason! Apr 27th
If ((strTag = Empty) And (strForm = "fInvMain")) Then strTag = Screen.ActiveForm.txtTag 'Attempt to add tag# to entry
strStatus = cleanString(strStatus)
strDatum = cleanString(strDatum)
strComment = cleanString(strComment)
strSQL = "INSERT INTO tEvents(txtdate, myerrno, interrno, myerrmsg, interrmsg, txtform, stack, process, Datum, idLink) VALUES ('" & Now() & "','" & intType & "','" & erNo & "','" & strStatus & "','" & strComment & "','" & strForm & "','" & strErrStack & "','" & pXname & "','" & strDatum & "','" & strTag & "');"
CurrentDb.Execute strSQL, dbFailOnError
Exit Function
err_hand:
If Err.Number = 2475 Then
bEcho = False
Resume reS
Else: MsgBox "555: CStatus Internal Error, Turn off error handling to view"
End If
End Function
I need a boolean true or false IF form is active. If it isn't, I can't put stuff into a textbox in that.
To determine if a particular form is open then set focus to form:
If CurrentProject.AllForms("finvmain").IsLoaded
strForm = "finvmain"
Elseif CurrentProject.AllForms("fclips").IsLoaded Then
strForm = "fclips"
End If
If strForm <> "" Then DoCmd.SelectObject acForm, strForm
I have the following code to check windows updates
Function CheckWinUpdates() As Integer
CheckWinUpdates = 0
Dim WUSession As UpdateSession
Dim WUSearcher As UpdateSearcher
Dim WUSearchResults As ISearchResult
Try
WUSession = New UpdateSession
WUSearcher = WUSession.CreateUpdateSearcher()
WUSearchResults = WUSearcher.Search("IsInstalled=0 and Type='Software'")
CheckWinUpdates = WUSearchResults.Updates.Count
Catch ex As Exception
CheckWinUpdates = -1
End Try
If CheckWinUpdates > 0 Then
Try
'Dim Update As IUpdate
Dim i As Integer = 0
For i = 0 To WUSearchResults.Updates.Count - 1
'Update = WUSearchResults.Updates.Item(i)
EventLog.WriteEntry("Item is type: " & WUSearchResults.Updates.Item(i).ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Deadline: " & WUSearchResults.Updates.Item(i).Deadline.ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Type: " & WUSearchResults.Updates.Item(i).Type.ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Released on: " & WUSearchResults.Updates.Item(i).LastDeploymentChangeTime, EventLogEntryType.Information, 85)
EventLog.WriteEntry("This windows update is required: " & WUSearchResults.Updates.Item(i).Title, EventLogEntryType.Information, 85)
'EventLog.WriteEntry("This windows update is required: " & Update.Title & vbCrLf & "Released on: " &
' Update.LastDeploymentChangeTime & vbCrLf & "Type: " & Update.Type.ToString & vbCrLf &
' "Deadline: " & Update.Deadline.ToString & vbCrLf & vbCrLf & "Item is type: " & Update.ToString, EventLogEntryType.Information, 85)
Next
Catch ex As Exception
EventLog.WriteEntry("Error while attempting to log required updates:" & vbCrLf & ex.Message, EventLogEntryType.Error, 86)
End Try
End If
WUSearchResults = Nothing
WUSearcher = Nothing
WUSession = Nothing
End Function
My intention with this is to a) get the number of windows updates that are applicable, and b) to look at what other properties are available, and more specifically see how many are older than a week or 2.
I know that UpdateSearcher doesn't allow to search by date, so I am looking to iterate through each item and then later report on each one.
At the moment my function does quite happily return the number of updtes, but when I try to get any of the properties I get "Object reference not set to an instance of an object".
Any ideas where I'm going wrong?
I got this working, turns it it doesn't like the deadline property, I don't know it comes up with "object reference not set", but for what I need it doesn't matter.
The problem of this script is that it shows an unknown error Message while running the script.
I called the function by echo method in my ftp which is "filezilla".
every thing is working fine as it logs into the server check for the path, open channel for data writing. Still dont know where is the problem
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalFile = Trim(sLocalFile)
'----------Path Checks---------
'Here we willcheck the path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = """" & sLocalFile & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'Check the local path and file to ensure
'that either the a file that exists was
'passed or a wildcard was passed.
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
"space." & vbCRLF
FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
'nothing to upload
FTPUpload = "Error: File Not Found."
Exit Function
End If
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
'Write the input file for the ftp command
'to a temporary file.
Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Set fFTPScript = Nothing
oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
" > " & sFTPResults, 0, TRUE
Wscript.Sleep 1000
'Check results of transfer.
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
If InStr(sResults, "226 Transfer complete.") > 0 Then
FTPUpload = True
ElseIf InStr(sResults, "File not found") > 0 Then
FTPUpload = "Error: File Not Found"
ElseIf InStr(sResults, "cannot log in.") > 0 Then
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
WScript.Echo "Process Completed (" & Now & ")"
End Function