I am using Ms Access forms and I have created an on click event that locates a folder location but now I want to locate the folder location based on different criteria but when I add the if statement it expects a sub,function or property. Below is some demo code. I really hope someone can explain what is missing?
Private Sub Open_Email_Click()
Dim stAppName As String
Dim stAppNameA As String
Dim stAppNameB As String
stAppName = "C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & " DEMO\B " & Me.BC & " " & Me.UC & "\"
stAppNameA = "C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & " DEMO\A\B " & Me.BC & " " & Me.UC & "\"
stAppNameB = "C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & " DEMO\B\B " & Me.BC & " " & Me.UC & "\"
If (Me.BC = "60") And Me.UC Like "REF123*" Then stAppNameA
ElseIf (Me.BC = "60") And Not Me.UC Like "REF123*" Then stAppNameB
Else: stAppName
End If
Call Shell(stAppName, 1)
End Sub
I think the logic of your function could be reduced to the following, which may be more readable with fewer repeating expressions:
Private Sub Open_Email_Click()
Dim strTmp As String
If Me.BC = "60" Then
If Me.UC Like "REF123*" Then
strTmp = " DEMO\A\B "
Else
strTmp = " DEMO\B\B "
End If
Else
strTmp = " DEMO\B "
End If
Call Shell("C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & strTmp & Me.BC & " " & Me.UC & "\", 1)
End Sub
Alternatively, using a Select Case statement:
Private Sub Open_Email_Click()
Dim strTmp As String
Select Case True
Case Me.BC <> "60"
strTmp = " DEMO\B "
Case Me.UC Like "REF123*"
strTmp = " DEMO\A\B "
Case Else
strTmp = " DEMO\B\B "
End Select
Call Shell("C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & strTmp & Me.BC & " " & Me.UC & "\", 1)
End Sub
To test the resulting path, change:
Call Shell("C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & strTmp & Me.BC & " " & Me.UC & "\", 1)
To:
Debug.Print "C:\Windows\explorer.exe C:\DEMO\TEST\" & Me.Office & strTmp & Me.BC & " " & Me.UC & "\"
I think your If block is just a bit messy in terms of where you have newlines, and continuation characters (:). Try reformatting your code like this:
If (Me.BC = "60") And Me.UC Like "REF123*" Then
stAppName =stAppNameA
ElseIf (Me.BC = "60") And Not Me.UC Like "REF123*" Then
stAppName = stAppNameB
Else
stAppName =stAppName
End If
Call Shell(stAppName, 1)
Related
This code is designed to detect the columns of start and finish of a shape which is used and displayed onto the caption of the shape itself. The following code is the problematic code:
Sub Take_Baseline()
Dim forcast_weeksStart() As String
Dim forcast_weeksEnd() As String
Dim forcastDate As String
Dim shp As Shape
Dim split_text() As String
'cycle through all the shapes in the worsheet and enter the forcast date for all the projects into their respective boxes
For Each shp In ActiveSheet.Shapes
'initialize forcast date by parsing
forcast_weeksStart = Split(shp.TopLeftCell.Column.Text, " ")
forcast_weeksEnd = Split(shp.BottomRightCell.Column.Text, " ")
forcastDate = forcast_weeksStart(1) & "-" & forcast_weeksEnd(1)
temp = shp.OLEFormat.Object.Object.Caption
If InStr(temp, "/-/") > 0 & InStr(temp, "In Prog") Then
split_text = Split(shp.OLEFormat.Object.Caption, " ")
For i = 0 To (i = 3)
shp.TextFrame.Characters.Caption = split_text(i) & vbNewLine
Next i
ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption = ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption & vbNewLine & ActiveSheet.Cells(4, AShape.TopLeftCell.Column).Text & " - " & ActiveSheet.Cells(4, AShape.BottomRightCell.Column).Text & vbNewLine & "dates: " & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & "/" & "actualDate"
' ElseIf InStr(temp, "/-/") > 0 & InStr(temp, "In Prog") = 0 Then
'split_text = Split(shp.OLEFormat.Object.Object.Caption, " ")
' For i = 0 To (i = 2)
' shp.OLEFormat.Object.Caption = split_text(i) & vbNewLine
' Next i
'ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption = ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption & vbNewLine & "In Prog" & vbNewLine & ActiveSheet.Cells(4, AShape.TopLeftCell.Column).Text & " - " & ActiveSheet.Cells(4, AShape.BottomRightCell.Column).Text & vbNewLine & "dates: " & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & "actualDate"
End If
Next shp
'For testing purposes
Sheet4.Range("A20").Value = forcast_weeksStart(1)
Sheet4.Range("A21").Value = forcast_weeksEnd(1) End Sub
The error is an
"invalid qualifier"
message which occurs on line
forcast_weeksStart = Split(shp.TopLeftCell.Column.Text, " ")
Right on the "column" word. I don't get why this is happening since the actual drop down menu has the column operation which i can select. I have tried everything from changing it to the OLEformat.Object.Caption etc etc. But nothing has worked. I am still relatively new to vba so any help will be appreciated. Thanks
I am having a column in an excel with some text(date, sender,subject) which refer to an email. The problem is that(as far as I know) you can hyperlink to an outlook email in public folders, because the email might move(link varies from pc to pc).
So my idea to obtain that email is to make a hyper link that fires of a macro in the personal.xlsb, that then search for that email and display it.
My only problem is that I can not figure out how to link text to start a macro, Worksheet_FollowHyperlink means that I need to put that code in the sheet where my text is.
I guess I could do that, but this implements that I need to create this code when the workbook is opened and remove it when the workbook is closed, unless I have to rename all the files xlsx to xlsm, and because I am unsure if other colleagues have link to the excel sheet I would like to avoid doing so.
So my question is, is there any way to make a hyperlink to personal.xlsb!ShowEmail(cellValue) ? Or is it possible to make direct link to the email in the public folder? Below is the code for creating the email text:
Function getEpostField(projectNumber As String, drawingNumber As String, partNumber As String) As String
On Error Resume Next
Dim myFolderArray() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim OutApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim myNewFolder As Object
Dim TopPublicFolder As Object
Dim olMail As Variant
Dim myTasks
Dim strFilter As String
Set OutApp = CreateObject("Outlook.Application")
Set myNameSpace = OutApp.GetNamespace("MAPI")
Set TopPublicFolder = myNameSpace.GetDefaultFolder(18)
getEpostField = ""
' array with all subfolders where the item might be...
myFolderArray = Post.helpRequest("XXXXXXXXX")
For i = LBound(myFolderArray) To UBound(myFolderArray)
Set myFolder = TopPublicFolder.Folders("Prototech").Folders(myFolderArray(i, 2)).Folders
For j = 1 To myFolder.Count
If InStr(myFolder(j).Name, projectNumber) Then
If drawingNumber <> "" And partNumber <> "" Then
strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & drawingNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & partNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & partNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & partNumber & "%'"
ElseIf drawingNumber <> "" Then
strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & drawingNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & drawingNumber & "%'"
ElseIf partNumber <> "" Then
strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & partNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & partNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & partNumber & "%'"
Else
getEpostField = "No emails found"
Exit Function
End If
Set filteredItems = myFolder(j).Items.Restrict(strFilter)
If filteredItems.Count = 0 Then
Debug.Print "No emails found"
getEpostField = "No emails found"
found = False
Else
found = True
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
attachmentString = ""
If itm.Attachments.Count > 0 Then
For Each temp In itm.Attachments
temp2 = InStr(temp.filename, drawingNumber)
If temp2 > 0 Then
attachmentString = attachmentString & temp.filename & " "
End If
Next temp
End If
Debug.Print "Dato:" & Format(itm.CreationTime, "mm.dd.yyyy") & " Subject:" & itm.Subject & " From:" & itm.SenderName & " Attachment:" & attachmentString
getEpostField = getEpostField + "Dato:" & Format(itm.CreationTime, "mm.dd.yyyy") & " Subject:" & itm.Subject & " From:" & itm.SenderName & " Attachment:" & attachmentString
Next
End If
'If the subject isn't found:
If Not found Then
'NoResults.Show
Else
Debug.Print "Found " & filteredItems.Count & " items."
End If
Exit Function
End If
Next j
Next i
End Function
=HYPERLINK("#personal.xlsb!modUtility.TestHL()","Test")
and a test function (returning a range a just results in the link selecting the already-selected cell)
Function TestHL()
Debug.Print "OK"
Set TestHL = Selection
End Function
There's no result or blank excel sheet in result of following SQL query. It works fine if I remove where condition but Its required. So kindly help me to correct my code with where condition. Code is follow-
Private Sub cmdOpenQuery_Click()
Dim strTableName As String
Dim strFieldName As String
Dim strFieldValue As String
Dim strFV As String
Dim strFieldType As String
Dim strBaseSQL As String
Dim strCriteria As String
Dim varItem As Variant
Dim strSQL As String
Dim qdf As DAO.QueryDef
Dim OutPut As String
Dim intCounter As Integer
Dim xlApp As Object
For Each qdf In CurrentDb.QueryDefs
If qdf.Name = "MyQry" Then
DoCmd.DeleteObject acQuery, "MyQry"
Exit For
End If
Next
strTableName = Me.[cboSelectTblQry]
strFieldName = Me.[cboWhere]
strFV = Me.[cboEqualto]
strFieldType = CurrentDb.TableDefs(Me.cboSelectTblQry).Fields(Me.cboWhere).Type
If strFieldType = 4 Then
strFieldValue = "[" & strFV & "]"
ElseIf strFieldType = 10 Then
strFieldValue = "['" & strFV & "']"
ElseIf strFieldType = 8 Then
strFieldValue = "[#" & strFV & "#]"
End If
strBaseSQL = "SELECT "
For intCounter = 0 To lstSelectTo.ListCount
lstSelectTo.Selected(intCounter) = True
Next intCounter
For Each varItem In Me![lstSelectTo].ItemsSelected
strCriteria = strCriteria & "[" & Me![lstSelectTo].ItemData(varItem) & "],"
Next
strSQL = strBaseSQL & Left$(strCriteria, Len(strCriteria) - 1) & " FROM [" & strTableName & "]" & " Where [" & strFieldName & "] = strFieldValue "
Set qdf = CurrentDb.CreateQueryDef("MyQry", strSQL)
If cboFormat = "Excel" Then
OutPut = "D:/Export_" & strTableName & "_" & Date & ".xlsx"
DoCmd.TransferSpreadsheet acExport, , "MyQry", OutPut
MsgBox " File has been exported to " & OutPut
DoCmd.Close
DoCmd.OpenForm "frmCreateQry"
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open (OutPut)
xlApp.Visible = True
ElseIf cboFormat = "PDF" Then
OutPut = "D:/Export_" & strTableName & "_" & Date & ".pdf"
DoCmd.OutputTo acOutputQuery, "MyQry", acFormatPDF, OutPut, True
MsgBox " File has been exported to " & OutPut
ElseIf cboFormat = "Word" Then
End If
ExitSub:
Exit Sub
ErrorHandler:
Resume ExitSub
End Sub
Your where condition is using strFieldValue as the value to look for. You should instead use the use held by strFieldValue for comparison. You're doing that properly with strTableName already. It is the same idea here. You'd need to enclose the value of strFieldValue in quotes when you add it.
strSQL = strBaseSQL & Left$(strCriteria, Len(strCriteria) - 1) & " FROM [" & strTableName & "]" & " Where [" & strFieldName & "] = '" & strFieldValue & "'"
I made some corrections and it's working now fine for all format like numeric, text and date type.
Following corrections made in Type condition :-
If strFieldType = 4 Then
strFieldValue = Me.cboEqualto
ElseIf strFieldType = 10 Then
strFieldValue = "'" & strFV & "'"
ElseIf strFieldType = 8 Then
strFieldValue = "#" & strFV & "#"
End If
and following correction in strSQL:-
strSQL = strBaseSQL & Left$(strCriteria, Len(strCriteria) - 1) & " FROM [" & strTableName & "]" & " Where [" & strFieldName & "] = " & strFieldValue & ""
hello i wrote this code to open a report based on a query
and this query is based on the toggle button
the problem is if i press one toggle button all work
but if i press more than toggle button in the same time it will not give me the right records or it will give me an empty report
this is the code
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tbl_Mouzakarat"
Dim p_7abes As String
Dim p_gharame As String
Dim p_done As String
Dim p_undone As String
Dim p_khoulasa As String
Dim p_mouzakara As String
Dim p_karar As String
Dim p_jaze2e As String
Dim p_lebanese As String
Dim p_foreign As String
Dim p_SQL_criteria As String
p_7abes = Trim(Me!text_7abes & " ")
p_gharame = Trim(Me!text_gharame & " ")
p_done = Trim(Me!text_done & " ")
p_undone = Trim(Me!text_undone & " ")
p_khoulasa = Trim(Me!text_khoulasa & " ")
p_mouzakara = Trim(Me!text_mouzakara & " ")
p_karar = Trim(Me!text_karar & " ")
p_jaze2e = Trim(Me!text_jaze2e & " ")
p_lebanese = Trim(Me!text_lebanese & " ")
p_foreign = Trim(Me!text_lebanese & " ")
If p_7abes <> "" Then
p_SQL_criteria = "[Punish]" & " LIKE '" & p_7abes & "'"
End If
If p_gharame <> "" Then
p_SQL_criteria = "[Punish]" & " LIKE '*" & p_gharame & "*'"
End If
If p_done <> "" Then
p_SQL_criteria = "[Status_Check]" & " LIKE '*" & p_done & "*'"
End If
If p_undone <> "" Then
p_SQL_criteria = "[Status_Check]" & " LIKE '*" & p_undone & "*'"
End If
If p_khoulasa <> "" Then
p_SQL_criteria = "[Type]" & " LIKE '*" & p_khoulasa & "*'"
End If
If p_mouzakara <> "" Then
p_SQL_criteria = "[Type]" & " LIKE '*" & p_mouzakara & "*'"
End If
If p_karar <> "" Then
p_SQL_criteria = "[Type]" & " LIKE '*" & p_karar & "*'"
End If
If p_jaze2e <> "" Then
p_SQL_criteria = "[Type]" & " LIKE '*" & p_jaze2e & "*'"
End If
If p_lebanese <> "" Then
p_SQL_criteria = "[Nationality]" & " LIKE '*" & p_lebanese & "*'"
End If
If p_foreign <> "" Then
p_SQL_criteria = "[Nationality]" & " NOT LIKE '*" & p_foreign & "*'"
End If
If Me.chk7abes.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.chkGharame.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.chkDone.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.ChkUndone.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.chkKhoulasa.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.chkMouzakara.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.chkKarar7abes.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
If Me.chkKararJaze2e.Value = True Then
DoCmd.RunSQL "INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
End If
DoCmd.OpenReport "rpt_Mouzakarat", acViewPreview
DoCmd.Close acForm, "frm_Printing"
will someone check the code please
You are overwriting p_SQL_criteria each time then running the same exact query each time no matter how many toggle buttons are pressed.
"INSERT INTO tbl_Mouzakarat select * from " & "[qry_Mouzakarat]" & " where " & p_SQL_criteria
This is always the exact same SQL statement for each of your DoCmd statements.
I'm not really sure how your toggle buttons interact with the parameters you are trying to create so it's hard to suggest solutions, but this is why your having the problem you are having.
I am working on VBA, from which I have to call a vbscript by passing some values.
Here is the code:
''VBA
'Below values are on different cells of Excel file which I am reading
'into a global variable then pass it to vbscript.
'SFilename = VBscript file path
'QClogin = "abc"
'QCpassword = "abc"
'sDomain = "xyz"
'sProject = "xyz123"
'testPathALM = "Subject\xyz - Use it!\xyz_abc"
'QCurl = "http://xxx_yyy_zzz/qcbin/"
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("wscript " & SFilename & " " & QClogin & _
" " & "" & QCpassword & " " & "" & sDomain & " " & "" & sProject & _
" " & "" & testPathALM & " " & "" & QCurl & "")
''VBscript on some location
Dim strUserName, strPassword, strServer
strUserName = WScript.Arguments(0) '"abc"
Msgbox "strUserName : " & strUserName
strPassword = WScript.Arguments(1) '"abc"
Msgbox "strPassword : " & strPassword
strServer = WScript.Arguments(5) '"http://xxx_yyy_zzz/qcbin/"
Msgbox "strServer : " & strServer
Dim strDomain, strProject, strRootNode
strDomain = WScript.Arguments(2) '"xyz"
Msgbox "strDomain: " & strDomain
strProject = WScript.Arguments(3) '"xyz123"
Msgbox "strProject: " & strProject
strRootNode = WScript.Arguments(4) '"Subject\xyz - Use it!\xyz_abc"
Msgbox "strRootNode: " & strRootNode
Now, when I running the code, it is passing below values properly to vbscript:
QClogin = "abc"
QCpassword = "abc"
sDomain = "xyz"
sProject = "xyz123"
It is having issues with these:
testPathALM = "Subject\xyz - Use it!\xyz_abc"
QCurl = "http://xxx_yyy_zzz/qcbin/"
Now, wierd thing for me is, if I keep a cell empty for "testPathALM" which is having "Subject\xyz - Use it!\xyz_abc" as value, I am getting "QCurl" value properly in vbscript.
But, if I keep value "Subject\xyz - Use it!\xyz_abc" for "testPathALM", then I am getting "-" for strServer which suppose to be "QCurl" value and "Subject\xyz" for "strRootNode" which supposed to be "Subject\xyz - Use it!\xyz_abc".
I am unable to understand what is the issue here.
Thanks a ton in advance.
Safer to quote all of your parameters:
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("wscript """ & SFilename & """ """ & _
QClogin & """ """ & QCpassword & """ """ & _
sDomain & """ """ & sProject & """ """ & _
testPathALM & """ """ & QCurl & """")
Try a debug.print to make sure it looks as it should...