Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all 21197 articles
Browse latest View live

[RESOLVED] CALCULATING only Working day in datediff....

$
0
0
if DateDiff("d", strDBRows(10, I), Date) >= 3 then ....

Possible to not consider Saturday Sunday, in this line?

In effect calculating only a working days...

Cyber Cafe Billing System

$
0
0
hi guys im kind of new to this VB, i would like to develop a internet cafe billing system can anybody help me with what i need to know and what i need to research on, to make my research process a lot more easier so i can go straight to the point and do the research i need to?

File search from two folders

$
0
0
Hopefully I can explain this clearly enough...

I have a program (below) that searches file names from two different folder and opens them up simulataneously.
In Folder 1, the file names are like this 1998M730001 (only the 1st 7 characters are important in this folder) or L592530001 (Only the first 6 characters are important in these files that begin with L)
In the Folder 2, the file name are like this: 1998M73G001 (note the additional G) or L59253G001. In this folder, all characters are significant.
(Some of the file names begin with an "L" and down at the bottom of the code, there is a function that says to only search out to 6 digits for those that begin with L and 7 digits for those that don't start with L)

Here is what i want it to do: In some cases, there are similar names like 1998M73G002 in Folder 2 and right now the code is only searching out to 6 digits for some and 7 digits for the other. I would like it to stay that way for the Folder 1 search but for the Folder 2 search(highlighted below), I would like to search out to 11 digits for files that don't start with L and 10 digits for those that do start with L.

Thank you for any help and let me know if you have any questions.

---------------------------------------------------------------------------------------------------------------
Dim strSearchFileName, strFolderName1, strFolderName2, strFile1, strFile2
'Parameters
strSearchFileName = getSearchFile()
If strSearchFileName = "" Then WScript.quit()
strFolderName1 = "K:\08 Admin Support\02 Develop & Control Docs & Data\09 Industry Docs\Customer Standards\GEAE\GE Drawings"
strFolderName2 = "K:\08 Admin Support\02 Develop & Control Docs & Data\17 Final Inspection Tech Cards"

'Get file if folder and file exists (Returns String)
strFile1 = getFile(strFolderName1, strSearchFileName)
[style="background-color: #ffff00;"] strFile2 = getFile(strFolderName2, strSearchFileName) [/style]

'If _strFile1 and _strFile2 are not equal to nothing open the files
If strFile1 <> "" And strFile2 <> "" Then
openFile(strFile1)
openFile(strFile2)
Else
MsgBox("A drawing containing '" & strSearchFileName & "' was not found in GEAE.")
End If

'Get file if folder and file exists (Returns String)
Private Function getFile(strFolderName, strFileName)
Dim objFSO, folder, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Verify passing folder exists
If objFSO.FolderExists(strFolderName) Then
Set folder = objFSO.GetFolder(strFolderName)

'Loop over all files in the folder until the searchFileName is found
For each file In folder.Files
If InStr(file.Name, strFileName) >=1 Then
getFile = file.path
Exit Function
End If
Next
End If

getFile = ""
End Function

'Get user input (Returns String)
Private Function getSearchFile()
getSearchFile = InputBox("Find a Part Number containing:" & vbCr & vbCr & "(Case Sensitive)" & vbCr & vbCr & "Examples: L59253 or 1967M33")

If Left(getSearchFile,1) = "L" Then
getSearchFile = Left(getSearchFile,6)

Else
getSearchFile = Left(getSearchFile,7)

End If

End Function

'Opens File
Private Sub openFile(strPath)
CreateObject("WScript.Shell").Run chr(34) & strPath & chr(34)
End Sub

[RESOLVED] Listbox/listview that supports paragraphs

$
0
0
Hi All,

Thanks for the info on encryption. I've now got plenty to work that one out. I'm now on to another problem.

I need to work out a log-viewer. I can work out the forms for new entries. However, I need to work out a way to display the entire log. It'll never be so long that there are any memory worries. Basically, the database table will have two fields: 1) date, 2) memo field.

I need a way (with a scroll bar) to just load up the entire table so the user can scroll down through the log and view it. (I can also work out a printable report, but just viewing will be more frequent than actual printing.)

I'm playing around with the ListView, but I don't see anyway to have it do word-wrapping. Basically, I'd like something like the following, but in a way that it could handle 100 or so log entries:

Name:  log.jpg
Views: 57
Size:  22.7 KB

Any ideas on how to get this done are appreciated.

Thank You,
Elroy
Attached Images
 

[RESOLVED] Addnew issue

$
0
0
Hello
Code:

RS.Open "select * from tbl1" & _
        " where Forename = '" & forname.Text & "' " & _
        "  and Lastname= '" & latname.Text & "'", _
        DB, adOpenDynamic, adLockOptimistic
    If RS.EOF Then
    RS.AddNew

With such code a user can add a new record by just filling forname.Text even if the latname.Text is empty.
But if later, he wants to add the lastname, a new record is going to be added.
Is there a way to overcome this issue?

XML routine crashing if node doesn't exist but not sure how to trap

$
0
0
Hi,

I am trying to put together a routine to extra information from an XML feed - some nodes have data, <custom>, but some do not. When they do not, the routine crashes with an error as the data is not there.

I have thrawled the internet all day to investigate a solution but can't find anything. Does anyone know how to trap this?

Thanks,
John


Code:

Option Explicit
Dim strXML As String
Dim results() As String
Dim csssave As String

Private Sub Command1_Click()

    Dim objDoc As MSXML2.DOMDocument
    Dim objNodelist As IXMLDOMNodeList
    Dim objNode As IXMLDOMNode
    Dim i As Integer
    Dim splittervalue, contentdt, contenttime, contentdate As String
   
    'load the XML
    Set objDoc = New DOMDocument
    objDoc.async = False
    objDoc.loadXML strXML

  ' On Error Resume Next
           
    'Get a nodelist with all the customerDetail nodes
    Set objNodelist = objDoc.selectNodes("//billing-log/entry")
   
    'Loop through the nodelist and pull the vaules you need
    For Each objNode In objNodelist
        If objNode.selectSingleNode("custom").Text <> "" Then
            splittervalue = objNode.selectSingleNode("custom").Text & "|"
           
            ' Obtain date and time from XML
            contentdt = objNode.selectSingleNode("in").Text
            ' Date
            contentdate = Mid(contentdt, 9, 2) & "-"
            contentdate = contentdate & Mid(contentdt, 6, 2) & "-"
            contentdate = contentdate & Left(contentdt, 4)
            ' Time
            contenttime = contenttime & Mid(contentdt, 12, 8)
            ' Construct splitable string
            splittervalue = splittervalue & contentdate & "|"
            splittervalue = splittervalue & contenttime & "|"
           
            ' Split the constructed string
            Splitvalues (splittervalue)
           
            ' Reset constructor strings
            contentdate = ""
            contenttime = ""
           
        End If
    Next objNode
   
    Debug.Print csssave
   
    'Cleanup
    Set objNodelist = Nothing
    Set objDoc = Nothing
   
End Sub

Function Splitvalues(splitter As String)

    'Debug.Print splitter
    Dim splitarray() As String
    Dim i As Integer

    splitarray = Split(splitter, "|")

    ' Create CSV string to save
    csssave = csssave & splitarray(1) & "," & splitarray(2) & "," & splitarray(3) & "," & splitarray(4) & "," & splitarray(5) & "," & vbCrLf

End Function

Private Sub Form_Load()

    Dim handle As Integer
    handle = FreeFile
    Open "bill20161205.log" For Input As #handle
    strXML = Input$(LOF(handle), handle)
    Close #handle

End Sub

Attached Files

How do I let ComboBoxes show more than 8 items?

$
0
0
Preferably without turning to using Windows API functions, as a number of other websites have suggested. Is there some undocumented function in the VB6 ComboBox control itself, that lets you change the maximum number of items to display in the dropdown part of a ComboBox?

Err.Raise for passing HRESULT returns in Implements class functions

$
0
0
So I noticed some classes don't swap out functions that need a non-zero return, but instead just use Err.Raise. I started doing so myself thinking it would save a lot of work, until I ran up against a problem: this doesn't always work.

In one of my oleexp projects, I implemented IFolderFilter. Returning S_FALSE makes an item hidden, and not swapping it out and doing Err.Raise S_FALSE works fine. But then I implemented the very similar IShellItemFilter, which uses the same S_FALSE return to hide items-- but in this case Err.Raise S_FALSE does not work, while swapping it out and returning S_FALSE in a normal function does.

Could someone explain why this doesn't always work and how one might determine if it will in advance?

use of registry

$
0
0
hi,

i am pretty new to VB6 and still in learning stage.

Could someone outline the need to use registry in vb6 programs?

thanks!

Creating a UI for CNC Laser Engraver

$
0
0
Just want to ask about the CNC Laser Engraver's User Interface (UI). We found a readily available UI, the "GRBL Controller" online and we wanted to create our own version it. Regarding this, I'd like to ask your idea about how we can create this UI. Can we do it using Visual Basic or there are other UI maker that would fit this application. The goal of the UI is to upload pictures from the computer and draw (print) this via CNC Laser.

[RESOLVED] what is the proper starting time in 12-hour clock system in VB6?

$
0
0
I am confused what is the proper starting time in 12-hour clock system, either 12:00 a.m or 00:00 a.m?

12:00 AM ~ 12:00 PM ~ 11:59 PM

Or

00:00 AM ~ 12:00 AM ~ 12:00 PM

Error 91

$
0
0
This code is a 2 recordset statement to subtract a (buy_tab) qunty from (invent) begin_balance it is giving me a run time error (3020) update or cancel update without addnewor edit " rds1!begin_balance = rds1!begin_balance - rds2!qunty" , note that the (invent & buy_tab) are two tables
- Public Sub SUBPRO()
Dim DBS As DAO.Database
Set DBS= CurrentDb
Dim rds1 As Recordset
Dim rds2 As Recordset
Set rds1 = DBS.OpenRecordset("invent")
Set rds2 = DBS.OpenRecordset("buy_tab")
rds1.MoveFirst
Do Until rds1.EOF
rds2.MoveFirst
Do Until rds2.EOF
If rds1!ItemID = rds2!Nost Then
rds1!begin_balance = rds1!begin_balance - rds2!qunty
End If
rds1.Update
rds1.MoveNext
Loop
Loop
rds1.Close
rds2.Close
DBS.Close
End Sub

[RESOLVED] Setting TOM/ITextRange with RTF text...Possible?

$
0
0
I'm trying to set the text of an ITextRange object to a snippet of RTF text rather than plain text without much luck.

Setting the ITextRange.Text property with RTF text shows all the RTF raw.

Also tried setting ITextRange.FormattedText.Text property, but got the same result as above.

I tried setting the tom.Rtf(Range) property, but it is read only.

I notice there is a Paste method that takes an IDataObject and that might work. However, I don't want to mess with the clipboard, and searching the forum shows that creating a class that implements IDataObject is extremely difficult (see: http://www.vbforums.com/showthread.p...)-from-scratch).

Anyone have experience with this and know if it is possible?

[RESOLVED or maybe not] FlexGrid row height

$
0
0
Alright, even thought I got my paragraph problem worked out with text boxes, I'd still like to have the FlexGrid in my toolbox. I've worked out all the SxS manifest stuff. Now, I just need to learn/remember how to use the thing. It's been a while.

Alright, here's my problem. I'm turning wordwrap on, and I'm loading a "paragraph" from a memo field of a database.

Ideally, I'd like RowHeight to auto-size so the paragraph would fit. But I don't think I'm getting that, so I have to write that myself.

But how do I figure out how many lines of text are in a cell? Or, asked a bit differently, how do I find out the height of the text in a cell? If I had that, I could figure out what to set my RowHeight at.

Thanks,
Elroy

[RESOLVED] [Nevermind]


prevent duplication in listview

$
0
0
Hello all
This is my code to display my records on a listview.
Code:

Dim sSQL As String
ListView1.ListItems.Clear
Dim Lst As ListItem
sSQL = "select Pat_ID, date_Apoint, Pat_Name,Treat, Motif FROM patient_Tbl Left join Treat_Tbl on patient_Tbl.Id = Treat_Tbl.ID  WHERE (date_Apoint = #" & Format(Date, "mm/dd/yyyy") & "#)"
 RS.Open sSQL, DB, adOpenDynamic, adLockOptimistic
Do While Not RS.EOF
Set Lst = ListView1.ListItems.Add(, , RS!Pat_ID & "")
Lst.SubItems(1) = RS!Pat_Name
Lst.SubItems(2) = RS!Motif
Lst.SubItems(3) = RS!Treat
Lst.SubItems(4) = RS!date_Apoint
RS.MoveNext
Loop

This code allows duplicatin in the listview if the Pat_iD is duplicated in the child table. (Treat_Tbl).
How shall modify this code to prevent duplication , even the record ID is duplicated in Treat_Tbl.
Thank you very much fo helping me

vb6 apps on ARM (maybe?)

how can i get the alpha value from a color?

$
0
0
how can i get the alpha value from a color?
i'm trying:
Code:

(((color And &HFF000000) \ 16777216) And &HFF)
but i always get zero :(

VB6 Hex values always have FFFF on higher bits

$
0
0
Hellow,

I have a question

Why does VB6 mask higher bits with FFFF if i use 16bits value on a long variable type?

for example

Code:

Static x As Long

x = &HFF85

VB treats this as &HFFFFFF85 which is -123 in decimal but this is wrong

isn't the right value is &H0000FF85? which 65413 in decimal so why does VB add those FFFF?

Any suggestions for a fix?

Intel compute stick

$
0
0
Intel came out with the Intel Compute Stick. Apparently, its a little computer you plug into the HDMI on a TV. So now you use your TV like a computer. It has Win10 on it. My question is, can it run any application that would run on a PC Win10? Now lets narrow the question down; Will a VB6 application run on it?
Viewing all 21197 articles
Browse latest View live


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>