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

VBA (VB6) Telemetry - Test if this works in vb6

July 26, 2017, 9:35 am
$
0
0
Hey guys,
I have created a small utility tool for VBA (Excel, Access, Word,.. ) but would like to know if this also works in vb6.

Are you for a test? :)

If it works also in vb6, then it will enable us to, with only 1 line of code, track errors, events, metrics right from vb6 apps with help from Microsoft Azure - Application Insights.

In one sentence: If you are familiar with Facebook Pixel or Google Analytics, then you know what I’m talking about, this is similar but for your vb6 apps (if it will work).

Here is a short video how this error tracking works in VBA (Excel):
https://youtu.be/6MUUXdmTWTY

And here is the detailed step by step guide how to setup in VBA (Excel):
https://www.vbatelemetry.com/full-gu...cel-workbooks/

In theory it should work also in vb6. Only thing that I can see is one code block.

Code:
#If VBA7 Then
    Declare PtrSafe 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
#Else
    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
#End If
but we can replace this with:
Code:
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
Here is the Excel VBA project. For this to work you also need to download a small client app from my site (it is free), and to setup your free Azure account (If you don't have one). Short steps are explained in the Excel Workbook.

TrackError Simple Sample.zip

If you still have vb6 on your machine, I would be very gratefull if you could test it and comment here on anything.

:):):) Thanks, Davor
Attached Files
↧
Search

vb6 Installer

July 26, 2017, 5:05 pm
$
0
0
Is there such a thing ? Something the user could run and browse to a folder, copy the Vb6 exe there
and do any other setup things required ?
↧
↧

[RESOLVED] how to calculate Textboxes and sum in another textbox

July 26, 2017, 10:00 pm
$
0
0
hey
i Have 3 textboxes that i insert numbers inside.
i have another textbox which needs to calculate both of the textboxes
the first one i managed to calculate but all together i cant figure out.
need some help on this.

e.x
if i insert into TxtTenCent number 5 then the TxtSumTotal needs to be 0.50
if i insert into TxtFiftyCent number 2 then the TxtSumTotal needs to be 1.50

this is my code
TxtTenCent.Text = "0.10"
TxtFiftyCent.Text = "0.50"
TxtOneDollar.Text = "1"
TxtSumTotal.text = need to sum the Textboxes

Code:
Private Sub TxtTenCent_Change()
    Dim TxtTenCent As String
    TxtTenCent = "0.10"
    TxtTenCent= Format$(TxtTenCent * val(TxtTenCent.Text), "0.00")
    TxtSumTotal.Text = TxtTenCent
End Sub
tnx For Any help
salsa :)
↧

Calculate dateAdd function

July 27, 2017, 12:39 am
$
0
0
Hi hello,

Name: Date Add.jpg Views: 44 Size: 22.1 KB

I've trying to use DateAdd function,attached is the coding and dosplay output.
Can someone point out the part that I do wrong pls?



Private Sub cmdCalculate_Click()
Dim starttime As Date
Dim travelDuration As Double

starttime = Val(txtStart.Text)
travelDuration = Val(txtTravelDuration.Text)

lblComplete.Caption = DateAdd("n", travelDuration, starttime)
End Sub






Thanks
Attached Images
 
↧

Forget Password Case in VB6

July 27, 2017, 3:09 am
$
0
0
Hi, i'm thinking of a method that i can use, in a case where all the users in my program forget their passwords.

So my program is offline, so I'm thinking methods like security question, like the one in Facebook. The user input a question on which only him/her knows the answer. But, whith this kind of security measurement, there is still a chance that other people or someone knows the answer.

I also think of sending the password via email, but since i am a newb at vb 6, it probably will take a lot of time, probably 2 months to learn on how to do it, and my project has to be done in the next 17 days or so. Not to mention lots change in my paper that i have to make.

So, the question is, is there any better method? a simple and easy to make method, but is very effective?
↧
↧

Form Vanishes

July 27, 2017, 5:39 pm
$
0
0
After running my source code and stepping through , I used to see Form1. Now. for no apparent reason
it disappears the moment I click on almost anything in the project explorer or any code modules.

Is this a known condition ? What should it do, and can I revert to how it was. Perhaps its got corrupted
and I should copy all to a new project ?
↧

[RESOLVED] Unknown Window Message

July 28, 2017, 12:26 am
$
0
0
I've run across a window message that I don't understand and haven't been able to find on MSDN other then a reference to Windows CE 5.0.

Msg: &H313 787


I'm getting this message when invoking the Sysmenu as I release the right mouse button while hovering over a Titlebar.

Anyone know what this message is?

Thanks.
↧

VB6 + NextCloud or OwnCloud

July 28, 2017, 1:47 am
$
0
0
Hi

I am thinking to a project where a share of files between several programs could be done with NextCloud (or OwnCloud), using WebDav to access the files.

I think that everything could be done quite easily. After a few tests this morning it seems possible, but I have some problems connecting the NextCloud using the webdav.
I use XMLHTTP to connect, and have this error message "This is the WebDAV interface. It can only be accessed by WebDAV clients such as the Nextcloud desktop sync client."

I use this url : "https://XXX.XXX.XX/remote.php/dav"

Does someone here wrote a webdav class?
Or has interfaced an app with a NextCould/OwnCloud?

Thanks
↧
Search

"Change Hue" fails on many colors

July 28, 2017, 3:37 am
$
0
0
As only a casual plinker when it comes to graphics programming many things elude me. Color spaces are something I don't have my head around.

I was toying with some code to re-color bitmaps to be used as parts of user interfaces, basically small icons. I thought that simply changing "hue" would be 95% of the job. Sadly though I had an easy success with my first attempt I quickly realized I am off in the weeds somewhere.

In this sample Project I can change the target bitmap hue from original RED... to BLUE or to GREEN or back to RED, or even to CYAN... but the other colors all give me a RED result:

Name: sshot.png Views: 60 Size: 1.8 KB

There may just be a glaring coding error that I can't see, or I may have a complete misunderstanding of color spaces.

The program works by (1.) converting a new color from RGB to HSV components, then (2.) changing every pixel from RGB to HSV, then back to RGB swapping in the new hue value.

Any ideas?
Attached Images
 
Attached Files
↧
↧

MsWinSock.ocx question

July 28, 2017, 4:24 am
$
0
0
QUESTION

Which is the best maximun chunksize transmitted using SendData to avoid the "10035 A non-blocking socket operation could not be completed immediately." ?

BACKGROUND

I just implemented the "SendCompleted" event as recently moved server to MsWinSck (before was using cSocketMaster). But I don't know which is the best maximun chunk size to send before to wait for SendCompleted.

The server can handle like 500 connections over LAN ports 1000mbps as minimun required. And some few over WAN.

I had a customer which runs it in a Win7 with FX-4100 cpu, 8GB RAM, low specs I know, but he runs only like 80 connections over lan, and when in full activity the server starts logging the "A non-blocking ... error", and it don't just close some sockets, it closes all sockets and include the sockets which listens for new connections seems like unable to process the connection. And the error never goes away. So, like if it hits a critical performance problem, and all clients automatically reconnects, and it is unable to support that huge new traffic about 80 clients at all once trying to negotiating a reconnection plus all the data require to be transmitted again to akanowledge the new synchronization of the services going over the sockets.


QUESTION 2

Just writing the SendComplete event it is expected the error goes away? Or there is a property in the socket to setup?
↧

Display a Bitmap in a secondary DLL via HWND

July 28, 2017, 4:38 am
$
0
0
I would like to display a graphic, BMP or JPG or PNG, I don't mind which really, in a Picturebox located in a different DLL to the one that would actually load the image. The Images would likely be in a .Res file in that second DLL.

The images would be instructional telling the User what buttons they need to press on a piece of connected hardware.

So for example, the EXE runs and it loads a DLL, the Calling DLL. This Calling DLL has a Form and on that form is a Picturebox. The Calling DLL then loads a different DLL names Processing DLL. This Processing DLL talks to the hardware devices and in the Processing DLL there would be a resource file say Inf.Res containing a number of graphic images.

Currently I use the code below to send an image back to the Calling DLL from the Processing DLL. But in this case I am loading a Binary image from a database so I convert it and then send it using the DisplayRegion.hwnd of the Calling DLL which I have obtained elsewhere. And this works fine.

My issue is for my new task - I just want to pull a Graphic from a resource file and send that to the DisplayRegion.hwnd but I just cannot work out how to do that.

Would appreciate any thoughts / help.

thanks


Code:
Public Function paintImage(ByRef Bytes() As Byte, DisplayRegion As Scan.ScanDisplayRegion) As Long
10      On Error GoTo paintImage_Error

          Dim screen_hdc As Long
          Dim compat_dc As Long
          Dim hDIB As Long
          Dim mRect As RECT
         
30        Call GetWindowRect(DisplayRegion.hwnd, mRect)
         
       
40        screen_hdc = GetDC(0)                  'get screen's device context
50        hDIB = CreateDIBitmap(screen_hdc, bm_info.bmiHeader, CBM_INIT, Bytes(0), bm_info, DIB_RGB_COLORS)
60        compat_dc = CreateCompatibleDC(GetDC(DisplayRegion.hwnd))    'create a compatible device context.
70        SelectObject compat_dc, hDIB            'select the DIB into the compatible DC.
80        StretchBlt GetDC(DisplayRegion.hwnd), 0, 0, (mRect.Right - mRect.Left), (mRect.Bottom - mRect.Top), compat_dc, 0, 0, FACE_IMG_WIDTH, FACE_IMG_HEIGHT, SRCCOPY
90        DeleteDC compat_dc                      'destroy the DC
100      DeleteObject hDIB
↧

Grid modification

July 28, 2017, 4:53 am
$
0
0
I need to make a grid show the table by code, anyone know how?

NOTE: I already use the DATA of VB6, and want to stop using.
↧

compile error application.printers

July 28, 2017, 1:11 pm
$
0
0
I recently had to re-install my OS and MSAccess and now I am getting a compile error "Method or data member not found" with the debugger indicating a problem with the line:
Set Application.Printer = Application.Printers("Samsung XL-9900 Series")

I see that "Printers" is not included in the builder picklist after "application."

I see several workarounds that might work, but this code worked fine until the re-installations of the softwares.

Is there something I am missing? Obviously, there is....
↧
↧

open file size 2 gb

July 28, 2017, 5:16 pm
$
0
0
Hello there,
I want to open the file in 2 gb size. (Api or code) vb6 richtextbox.
How can I do?

I'm using google translate. Help me please.
↧

[RESOLVED] Determine run mode

July 28, 2017, 7:26 pm
$
0
0
Apart from app.path and app.exename can you determine if you're running a compiled exe file, or not ?

Thanks, Alex
↧
Search

Simple way to check lots of TextBoxes?

July 29, 2017, 12:55 am
$
0
0
So, this is not urgent, since I have a code that will work, but I just curious. I want to check whether any of the textboxes in a form is empty or not. I can create an if clause with "OR", like this:

if txt1.Text = "", OR txt2.Text = "", etc. then

.........


But i want to know if there is a better and simpler way to do this, since there are like 12 textboxes to check, and i dont want to write all of their name.

What i tried so far :

Code:
Dim kontrol As Control

If TypeOf kontrol is TextBox Then
    If kontrol.Text = "" Then
    MsgBox "Data is incomplete"
    End If
End If
But that code above does not work, and give me error in the second line.

Any suggestion?
↧

How to play a video file which is called: VIDEO.WEBM

July 29, 2017, 1:00 am
$
0
0
Hello me again, yeah it's ThEiMp, again...

I need to know how to play a video file, that is called: C:\Temp\VIDEO.WEBM and then to delete it after it has been playing on the local machine. I don't wish to delete the folder, just the file, of that name and extension, only on the current machine. Nothing malicious intended, I can't post the project, but then the source code, I could be able to. because of the video file is so big, making the resource and ocx build, file so in that way even bigger. I have then been able to make it a resource and then also a deployed video file on the current client machine. then I just need to play and then delete the very same file, even.

!! Thanks in advance !!
↧
↧

moved to sql from access new syntax code need some guidelines

July 29, 2017, 5:30 am
$
0
0
hey
i recently started to use sql server
i noticed that the syntax when trying to load certain columns and tables
are not the same as i did before with access.
e.x when i try to load or check date values
i get an error when i use this date syntax
Code:
#" & Now & "#
is there any list or syntax code that i can learn from?
regards
salsa :)
↧

Moving Border-less Form From Context Menu

July 29, 2017, 6:30 am
$
0
0
The SYSMENU has an option to Move a form, that when clicked, changes the mouse to a 4-way pointer positioned at the center of the corresponding programs TitleBar. The system then responds to the arrow keys allowing the user to position the Form. Striking any other key, or any mouse click, terminates the function restoring the mouse back to the standard pointer.

This no-longer works once a Forms border has been removed and I can’t even tell where this functionality lives?

Does anybody know whether the arrow key positioning of a Form is part of a programs Message-Pump, or does it reside in some other area of the OS.

Thanks.
↧

Sum Quantity and Price On Specific Condition

July 29, 2017, 8:36 am
$
0
0
I am trying to do a sum of price and quantity in an excel file and store them in database table. So here it's (Trying by myself for learning) - Suppose, these are the excel file data:

Code:
ProductId - Invoice No - Invoice Date - Price - Quantity
101 - Inv-1000 - 7/10/2017 10:00 - 1000 - 10
101 - Inv-1000 - 7/10/2017 10:30 - 200 - 2
101 - Inv-1000 - 7/10/2017 10:30 - 400 - 4 'These should be merged with the above one as they have the same invoice, product id and date time
102 - Inv-1000 - 7/10/2017 10:30 - 400 - 20
101 - Inv-1001 - 7/11/2017 10:30 - 300 - 5
102 - Inv-1001 - 7/11/2017 10:30 - 200 - 5
My requirement is if there is any product id with the same invoice and invoice date time, then it should merge those results and the output in the database table would be the following:

Code:
ProductId - Invoice No - Invoice Date - Price - Quantity - Auto No
101 - Inv-1000 - 7/10/2017 10:00 - 1000 - 10 - 1
101 - Inv-1000 - 7/10/2017 10:30 - 600 - 6 - 2 'Finally merged
102 - Inv-1000 - 7/10/2017 10:30 - 400 - 20 - 1
101 - Inv-1001 - 7/11/2017 10:30 - 300 - 5 - 1
102 - Inv-1001 - 7/11/2017 10:30 - 200 - 5 - 1
So I tried it with following code validating invoice no, product id and invoice date time in a sql query:

Code:
str = "SELECT IIF(SUM([Price]) IS NULL, 0, SUM([Price])) AS SumPrice, IIF(SUM([Quantity]) IS NULL, 0, SUM([Quantity])) AS SumQuantity FROM [" & strSheet & "$]" & _
      " WHERE [Invoice No] = '" + InvNo + "'" & _
      " AND [ProductId] = '" + ProductId+ "'" & _
      " AND [Invoice Date] = '" + strDate + "'"

Set rs = con.Execute(str)
But in WHERE clause, I get these error - Data type mismatch in criteria expression.

After the error message, I did use only the invoice no with product id to check if that works and it did (For the invoice 'Inv-1000' and product id 101) like this but rest of the excel data aren't loaded -

Excel Data:

Code:
ProductId - Invoice No - Invoice Date - Price - Quantity
101 - Inv-1000 - 7/10/2017 10:00 - 1000 - 10
101 - Inv-1000 - 7/10/2017 10:30 - 200 - 2
101 - Inv-1000 - 7/10/2017 10:30 - 400 - 4
102 - Inv-1000 - 7/10/2017 10:30 - 400 - 20
101 - Inv-1001 - 7/11/2017 10:30 - 300 - 5
102 - Inv-1001 - 7/11/2017 10:30 - 200 - 5
Output in the database table:

Code:
ProductId - Invoice No - Invoice Date - Price - Quantity - Auto No
101 - Inv-1000 - 7/10/2017 10:00 - 1600 - 16 - 1
Note: One more thing, if the sum is done, I again would like to check or validate the sum shouldn't be entered twice for that particular invoice no, product id and invoice date (I've already done the validation in the sample project but for the sum, will the validation work?).

Here is the full code (Use a TextBox and keep the excel file in D directory, finally write this in the TextBox - D:\SampleExcel.xlsx):

Code:
Dim recordCount As Integer 'Variable to get record count
Dim i As Integer

Private Sub btnUpload_Click()
  LoadExcelSheet
End Sub

'**Method To Upload Excel File - Starts**
Public Sub LoadExcelSheet()
Dim con As ADODB.Connection
Dim conn As ADODB.Connection

'**Record Set To Check Table Records - Starts**
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim rs3 As ADODB.Recordset
'**Record Set To Check Table Records - Ends**

Dim i As Long

Dim strQuery As String
Dim str As String
Dim str2 As String
Dim strQuery2 As String
Dim strQuery3 As String

Dim strFile As String
Dim strSheet As String


Set con = New ADODB.Connection
Set conn = New ADODB.Connection

Set rs = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
Set rs3 = New ADODB.Recordset

i = 0

strFile = txtFileName.Text
strSheet = "Sheet1"
con.Provider = "Microsoft.ACE.OLEDB.12.0"
con.ConnectionString = "Data Source = " & strFile & ";" & "Extended Properties = Excel 12.0;"

conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Demo;Data Source=.;"
con.Open

strQuery = "SELECT * FROM [" & strSheet & "$]"
strQuery2 = "SELECT ProductId, [Invoice No], [Invoice Date] FROM DataExcel"
strQuery3 = "SELECT ProductId, [Invoice No], [Invoice Date], [Price], [Quantity] FROM DataExcel"

rs.Open strQuery, con, adOpenStatic, adLockOptimistic
rs2.Open strQuery2, conn, adOpenStatic, adLockOptimistic
rs3.Open strQuery3, conn, adOpenStatic, adLockOptimistic

strDate = Format(Now, "YYYY-MM-DD") + " 00:00:00"

If (rs2.recordCount > 1) Then
  MsgBox "Few or all records already exist! Check excel file."
ElseIf (rs.Fields(0).Name <> rs3.Fields(0).Name Or rs.Fields(1).Name <> rs3.Fields(1).Name Or rs.Fields(2).Name <> rs3.Fields(2).Name Or rs.Fields(3).Name <> rs3.Fields(3).Name Or rs.Fields(4).Name <> rs3.Fields(4).Name) Then
  MsgBox "Column names don't match! Please check excel file."
Else
    Do Until rs.EOF
    Dim InvNo As String
    InvNo = rs.Fields(1).Value

    Dim AutoNo As String
    Dim AutoNo2 As Integer

    Dim ProductId As String
    ProductId = rs.Fields(0).Value

    Dim ProductId2 As Integer
    ProductId2 = rs.Fields(0).Value

    Dim InvoiceDate As String
    InvoiceDate = Trim(rs.Fields(2).Value)

    Dim Price As String
    Price = Trim(rs.Fields(3).Value)

    Dim Quantity As String
    Quantity = Trim(rs.Fields(4).Value)

    strDate = Format(InvoiceDate, "YYYY/MM/DD hh:mm:ss")

    'This is what I am doing - Checking the same invoice no, product id and invoice date.
    'If any found in the excel file, then sum up the quantity and price
    str = "SELECT IIF(SUM([Price]) IS NULL, 0, SUM([Price])) AS SumPrice, IIF(SUM([Quantity]) IS NULL, 0, SUM([Quantity])) AS SumQuantity FROM [" & strSheet & "$]" & _
          " WHERE [Invoice No] = '" + InvNo + "'" & _
          " AND [ProductId] = 101" & _
          " AND [Invoice Date] = '" + strDate + "'"

    Set rs = con.Execute(str)

    Quantity = rs.Fields("SumQuantity").Value
    Price = rs.Fields("SumPrice").Value

    'Here is the trick - Initially passed the excel file data to verify
    'and checking if any product id exists with the same invoice number in the database table
    str = "SELECT ISNULL(MAX([Auto No]),0) AS AutoNo FROM DataExcel" & _
          " WHERE [Invoice No] = '" + InvNo + "'" & _
          " AND [ProductId] = '" + ProductId + "'"

    Set rs2 = conn.Execute(str) 'Gets the auto number

    AutoNo2 = rs2.Fields("AutoNo").Value + 1 'Increments the number by one if any duplicate exists
    AutoNo = AutoNo2 & ""

    str = "INSERT INTO DataExcel (" & _
          "[ProductId], " & _
          "[Invoice No], " & _
          "[Invoice Date], " & _
          "Price, " & _
          "Quantity, " & _
          "[Auto No]" & _
          ") VALUES (" & _
          "'" + ProductId + "'," & _
          "'" + InvNo + "'," & _
          "'" + InvoiceDate + "'," & _
          "'" + Trim(Price) + "'," & _
          "'" + Trim(Quantity) + "'," & _
          "'" + AutoNo + "')"
    conn.Execute (str) 'Finally stores data with tracking or serial numbers

  rs.MoveNext
Loop
End If

rs.Close

Set rs = Nothing

con.Close
conn.Close

Set con = Nothing
Set conn = Nothing
End Sub
'**Method To Upload Excel File - Ends**
↧
Viewing all 21896 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>