[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x

Visual Basic Classic

164K

Solutions

58K

Contributors

Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.

Share tech news, updates, or what's on your mind.

Sign up to Post

Hi

I have this below code that generates BarCodes based on values from my MSHFlexgrid1 while the picture is in a PictureBox ("Picture1")

 when run in the IDE, I have each Picture related to the Value from my MSHFlexgrid1.
Ex:
No issue
When i run it with the .exe, this is when i have the problem where the pictures don't match.
Ex:
with issue
The code i have is:
  xlObj.ActiveWorkbook.ActiveSheet.range("A1") = "BARCODE"
    xlObj.ActiveWorkbook.ActiveSheet.range("B1") = "BARCODE VALUE"
    xlObj.ActiveWorkbook.ActiveSheet.Columns("A").ColumnWidth = 37.59


     With MSHFlexGrid1
        Dim gridRow As Long, xlRow As Long, LastRow As Long, xlDown As Long

        For gridRow = 1 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid1.TextMatrix(gridRow, 1) <> "" Then
  
                For xlRow = 2 To (MSHFlexGrid1.Rows - 1) + 1
                    If xlObj.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = "" Then

                        Form1.Text1.Text = MSHFlexGrid1.TextMatrix(gridRow, 1)
                        makeBC
                        
                        DoEvents

                        '********************************************************************************************************
                        SavePicture Picture1.Image, "C:\Pic.bmp"
                        '********************************************************************************************************

                       ' Sleep 200 ' to

Open in new window

0
Learn Ruby Fundamentals
LVL 12
Learn Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

Hi

I would like to extract each barcode picture from my MSHFlexgrid1 into excel so that people can scan them.

Right now, it only extract the number and not the barcode itself.

How can i do the barcode extract?

Bacode in mshflexgrid1
This is the extract code i have.

  Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
    Dim wkbOut As Object   'Excel.Workbook
    Dim wksOut As Object   'Excel.Worksheet
    Dim rngOut As Object   'Excel.Range
    Dim sngStart As Single    'forperformance measurement
    Dim start_time As Long
    Dim end_time As Long
    Dim total_time As Long
    Dim FileNm As Variant

    On Error Resume Next

    'Save file to
    With CommonDialog2
        .DialogTitle = "BarCode extract..."
        .FileName = Label3.Caption
        .CancelError = True  '<--moved
        '.Filter = "Excel Files (*.xls)|*.xls"
        ' .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"
        .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"
        .ShowSave


        If Err.Number = 32755 Then
            MsgBox "not saved - user pressed cancel or closed the dialog"
            Exit Sub
        Else
            FileNm = .FileName
            path_link = FileNm & ".xls"
        End If

    End With
    'output to Excel workbook
    '  lblStatus.Caption = "Begin Excel Data Export"
    Set xlObj = CreateObject("Excel.Application")
    Set wkbOut = xlObj.Workbooks.Add
 

Open in new window

0
The "store56_A" and "store57_A" are parameters that are returned from a stored procedure.  The problem is that in the return set, only one value is returned at a time, because the values are on different rows.  Meaning that store56_A and store57_A have a location ID that are the same, for example 25555 belongs to both store 56 and 57, but they have different amounts of items in each store, i.e. the "storecount".

I have tried the below VB6 code in an effort to write both values out to the same row in a csv file, however they both continue to come out on different rows within the file when created.  I am not sure if the problem is with the below code, or the store procedure, but the values returned in the SP seem to be correct.

if .fields("code").value = 56 and .fields("storecount") <> 0 then
      .fields("store56").value = .fields("store56_A").value
elseif .fields("code").value = 57 and .fields("storecount") <> 0 then
      .fields("store57").value = .fields("store57_A").value
else
.fields("store56").value = 0
.fields("store57").value = 0
end if


The store procedure has these values that are returned:

SELECT skuitem, storelocation, storecount_total, description, b.storecount as store56_A, c.storecount as store57_A
From products a
Inner Join storeitems b ON a.skuitem = b.skuitem
Inner Join storeitems c ON a.skuitem = c.skuitem
Where a.storelocation = b.storelocation

Products Table

Name      skuitem      Storecount_total      storelocation
Oklahoma      25555      3400      56
Orlando…
0
I had a GREAT spreadsheet until I added some lines and columns.  

In the account number fields (found throughout) when you entered 1234
you got 1234-00-00
When you entered 12
you got 1200-00-00
When you entered 123456
you got 1234-56-00

Suddenly, not only is that routing not working, once active content is enable, any entry to a custom or numeric field gets a Debug error. Sample spreadsheet is attached.

I know the problem is in VBA, but even when I update the routine with the appropriate cell numbers, ranges, I still get the error.
ABC---Last-National-Bank---1801-Ban.xlsm
0
Hi

On how to Pragmatically Click
"5 Hours" in the timing TAB of the site below.
the default is "Hourly"

this is the site
https://www.investing.com/crypto/dogecoin/doge-btc-technical

require

Javascript  example
that i could use with
Set IE = CreateObject("InternetExplorer.Application")
and VB6

 or  

any example I  could  implement from VB6
currently i have a web-browser control



Thank You
0
I'm using the below code to delete outlook items wit xlsx attachments. The issue encountered is that only some of the emails are deleted. Any thoughts

On Error GoTo SaveAttachmentsToFolder_err

    Dim ns As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
    
    Dim SubFolder As MAPIFolder
    
    
    
    
    Set ns = GetNamespace("MAPI")

    Set recip = ns.CreateRecipient("OMHA.HQ.MI.REPORTS")
   
    Set Inbox = ns.GetSharedDefaultFolder(recip, olFolderInbox)
    
    Set SubFolder = Inbox.Folders("MATS")


    If SubFolder.Items.Count = 0 Then
    
        MsgBox "There are no messages with attachments in the MATS folder.", vbInformation, _
                "Nothing Found"
        Exit Sub
    End If

    
    
    
    'Delete Outlook items
    For Each Item In SubFolder.Items
    For Each Atmt In Item.attachments
    If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
    Item.Delete
    End If
    Next Atmt
    Next Item
   
    
    
  
    
    ' Clear memory
SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle Errors
SaveAttachmentsToFolder_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & 

Open in new window

1
Hi,

I have below code that copy what's in MSHFlexgrid3 into an Excel file. Up to now, i don't have any problem.

What i want to do is to save the file in XML Speadsheet 2003 (formatFile = 46 if i'm not mistaken.)

Using below code do save it as .xml but everytime i extract, i need to re-save as XML Speadsheet 2003 and then it works.

Would you understand why? How can I fix it?

Thank you for your help.

 Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
    Dim wkbOut As Object   'Excel.Workbook
    Dim wksOut As Object   'Excel.Worksheet
    Dim rngOut As Object   'Excel.Range
    Dim sngStart As Single    'forperformance measurement
    Dim start_time As Long
    Dim end_time As Long
    Dim total_time As Long
    Dim FileNm As Variant


    'Save file to
    With CommonDialog1
        .DialogTitle = "Data Extract..."
        .Filename = environment_id.Text & " - extract"
        .CancelError = True  '<--moved
        .Filter = "Spreadsheet Files (*.xml)|*.xml| 2k7 Excel Files (*.xml)|*.xml"
        .ShowSave


        If Err.Number = 32755 Then
            MsgBox "not saved - user pressed cancel or closed the dialog"
            Exit Sub
        Else
            FileNm = .Filename
            path_link = FileNm
        End If

    End With
	
    'output to Excel workbook
    '  lblStatus.Caption = "Begin Excel Data Export"
    Set xlObj = CreateObject("Excel.Application")
    Set wkbOut = xlObj.Workbooks.Add
    Set wksOut =

Open in new window

0
I am trying to incorporate the following code concept into a worksheet.  I have a dropdown list staring at Cell E1. What I'm trying to do is if I select a value from the dropdown list that a macro is ran depending on the value.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True

    If Not Intersect(Target, Range("E1")) Is Nothing Then
        Select Case Range("E1")
       
            Case "Testing Value 1"
                Macro1
            Case "Testing Value 2"
                Macro2 ""
            Case "Testing Value 3"
                Macro3
        End Select
    End If
    End Sub
Sub Macro1()
MsgBox "Here it is 1"
End Sub
Sub Macro2()
MsgBox "Here it is 2"
End Sub
Sub Macro3()
MsgBox "Here it is 3"
End Sub
0
Hi, Experts,
How to stop and start mssqlserver using vb6 with Windows 10? I'm using Sql Server 2008. Thanks!
0
I am trying to interface into a OMEGA temperature probe so that I can actually read and display the temperature that the device reads. I am looking to reference the Unfiltered (0x0F) address location so that I can pull the information.

How would I go about doing that?

I have attached the address locations of the device.
Read_Write-Addresses.PNG
0
Microsoft Azure 2017
LVL 12
Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Hi Experts,

I have this question after resolving the following

https://www.experts-exchange.com/questions/29109077/How-to-concatenate-all-files-from-one-folder-into-one-ignoring-headers.html#a42623555

How can I modify the command to

1- Ignore all headers
2- include only files created in specific date range
3- include only files with specific names, like "*PatSched* and "*PatChanges*"

Thanks in advance.
0
Hello,

i have a powerpoint presentation with 10 slides. I would like to create an index page where all the index numbers (1-10) are linked to their appropriate slide. So, clicking slide 4 in the index will automatically go to the actual slide 4.
Can one write a macro that will create the index page with links , say slide 1, for any amount of slides in a presentation?

Thank you,
CC
1
Hello

Required is any code and or Dll or any solution to digitally sign a url with a secret api-key and Post it back to the server that can work in VB6

This is an Example in PHP  , need some type of hash_hmac equivalence in VB6 and example if possible.

$apikey='xxx';
$apisecret='xxx'; 
$nonce=time(); 
$uri='https://bittrex.com/api/v1.1/market/getopenorders?apikey='.$apikey.'&nonce='.$nonce; 
$sign=hash_hmac('sha512',$uri,$apisecret); 
$ch = curl_init($uri); 
curl_setopt($ch, CURLOPT_HTTPHEADER, array('apisign:'.$sign)); 
$execResult = curl_exec($ch); 
$obj = json_decode($execResult);

Open in new window


For a more exact definition , I have a another question posted here that is kinda different since its is as far as I am on my own  
trying to solve this, but i think this is worthy as separate question .
Please I really need something that will work in vb6.

Thank You Experts
0
I need Help with code implementing Sha512 in VB6

here is part of the code and the ???????? is what i need help with
think I am getting close if you review the text below

'1
Dim My_Url_ToSend As String
My_Url_ToSend = "https://bittrex.com/api/v1.1/market/buylimit?" & tx_APIKEY & "&nonce=" & Trim(str(Time())) _
& "&market=" & txCurrencyBaseSelection & "&quantity=" & txLimitOrderAmount & "&rate=" & txLimitOrderPrice
'2
Dim signback As String
signback = ????????(My_Url_ToSend, tx_APIKEY_SECRET)
'3
G_xmlhttp.Open "GET", signback
G_xmlhttp.send ""
txResponseText = G_xmlhttp.responseText

Open in new window


 the ???????? is I think what i need help with

i found this code here:
VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512
http://khoiriyyah.blogspot.com/2012/06/vb6-hash-class-md5-sha-1-sha-256-sha.html
(code is pasted below), is uses "advapi32.dll"

It seems to work well

if i use   txEncripted = CreateSHA512HashString(txToEncrypt)

"The quick brown fox jumps over the lazy dog"

it does return the correct  SHA512Hash  

"07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6"


Now a server is giving me a Secret_Hash_Key , and a Sign_In Key.
I have a URL to send back
I'm not sure what to do next?

the php? example that was provided is:
$apikey='xxx';
$apisecret='xxx'; 
$nonce=time(); 
$uri='https://bittrex.com/api/v1.1/market/getopenorders?apikey='.$apikey.'&nonce='.$nonce; 
$sign=hash_hmac('sha512',$uri,$apisecret); 
$ch = curl_init($uri); 
curl_setopt($ch, CURLOPT_HTTPHEADER, array('apisign:'.$sign)); 
$execResult = curl_exec($ch); 

Open in new window


VBA example
nonce=int(round(time.time()*1000))
url ='https://bittrex.com/api/v1.1/market/getopenorders?apikey='+api_key+'&market=BTC-QTUM&nonce=' + str(int(time.time()))
signature = hmac.new(secret_key,url.encode(),hashlib.sha512).hexdigest()
headers = {'apisign': signature}
req = urllib.request.Request(url, headers=headers)
response = json.loads(urllib.request.urlopen(req).read())

Open in new window


This is my Current VB6 implementation without the encryption above added
Dim G_xmlhttp
Set G_xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim URLA As String
URLA = "https://bittrex.com/api/v1.1/market/buylimit?" & tx_APIKEY & "&nonce=" & Trim(str(Time())) _
& "&market=" & txCurrencyBaseSelection & "&quantity=" & txLimitOrderAmount & "&rate=" & txLimitOrderPrice
G_xmlhttp.Open "GET", URLA
G_xmlhttp.send ""
txResponseText = G_xmlhttp.responseText

Open in new window

0
Does anyone know of resources either in books or on the web, or does anyone have experience of using SCSI Pass Through / Direct using (ideally VB6).
I am interested in how to set up the IOCTL_SCSI_PASS_THROUGH / DIRECT without using .net I have tried some sample .net code and it is clunky and very slow.
0
Set timer to run at 12 AM everyday in access how to do that. You can see the code and details in the below thread.
i want to run the macro everyday 12AM. I search for it and could not find how to run on specific time.

https://www.experts-exchange.com/questions/29115749/Loop-through-query-and-send-email-everyday-at-12AM.html
0
I used this code to loop through a query and send email but I get this error.
Is there anyone can assist me?
test.JPG

Private Sub Form_Timer()
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String
Dim sSubject As String
Dim sMessageBody As String
 
Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("passport_expiry_15days", dbOpenSnapshot)
 
With rsEmail
        .MoveFirst
        Do Until rsEmail.EOF
            If IsNull(.Fields(12)) = False Then
            Set email = CreateObject("CDO.Message")
email.Subject = "Passport Expiry Notification 15 days"
email.From = "HR System <hrms@domain.com>"
email.To = .Fields(12)
email.TextBody = "Your passport will expire on " & .Fields(4)
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "admin"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "admin"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = "hrms@domain.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.domain.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
email.Configuration.Fields.Update
email.Send
Set email = Nothing
 MsgBox (.Fields(12))
            End If
            .MoveNext
        Loop
End With
Set MyDb = Nothing
Set rsEmail = Nothing
End Sub

Open in new window

0
so I have another one that you folks might be able to help me with with please.   See attached

Employee Name
Possible Colors of Product - RED, GREEN, YELLOW, PURPLE
Amount of Each Sale
Total of Each color

So I need to pivot table the data to show

Employee Name
How Many of Each Color for each employee
Total # of sales regardless of color for each employee
Total Amount of Sales for each employee

How do I get a pivot table to show me only RED or only BLUE, etc. in the respective columns?

Thanks much
0
Hi Experts,

We have a script that is downloading files from FTP server every 15 minutes.

I'm writing a function that will do the following.

Loop thru all files, process them, then delete them.

Part of the function is to see if file contains some data besides of just headers.
this is the code

Function CountOfRecords(sFolderPath As String, sFile As String) As Long
Dim fso
Dim folderPath
Dim file
Dim oFile
Dim fileContent
Dim arr
Dim cnt
Dim recCnt
Set fso = CreateObject("Scripting.FileSystemObject")
'folderPath = "C:\FTP\5-18\31\" 'Change the folder path as required and remember to add a back slash in the end
        Set oFile = fso.OpenTextFile(sFolderPath & sFile)
        fileContent = oFile.ReadAll
        arr = Split(fileContent, vbCrLf)
        If UBound(arr) > 0 Then
            cnt = cnt + 1
            recCnt = recCnt + UBound(arr)
        End If
        oFile.Close
        Set oFile = Nothing
CountOfRecords = recCnt

End Function

Open in new window

However some times I get an error, permission denied.

guess when its still in middle the download process...

what is the solution?

Thanks on advance.
0
Big Business Goals? Which KPIs Will Help You
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Dear,
I get overflow error, due to the below line
                    RowID2 = c.Row

Open in new window

                   
in Macro (as attached). Why?
Gold-Star-ACER-BKSI-20082018-d.xlsm
0
Dear,
Is there one example to convert Font.Color of a VBA range, into string?
0
In Word's Visual Basic macro, I want to do a Find for a unique text and then highlight.  I'm a novice and could not find how to show in an IF statement, IF the text is found, progress with the statements that highlight the text and if nothing is found, don't.  Thanks.
0
How can I get the below "Desired Steps" #2 to work ?

Current Steps
1. enter "this is a test to delete THIS word I did by mistake" into CELL B1 in an EXCEL 2013 file
2. hit LEFT arrow on keyboard to delete the above "THIS" text
3. CELL A1 becomes active

Desired Steps
1. enter "this is a test to delete THIS word I did by mistake" into CELL B1 in an EXCEL 2013 file
2. hit LEFT arrow + something on keyboard
3. cursor appears behind the word "mistake", allowing me to LEFT arrow to "THIS" and backspace to remove "THIS"
0
Hi Experts,

We have an ADP project that was moved to another platform, and we want to make this now as read-only.
I created a SQL user that has only read permission, and changed the connection property of the project to that user/pwd.
Now I realized that a lot of code were programmed to perform auto updates...
for example the following upon users login...
    sSql = "Insert into InitialsLogins (Initial,PlacementVersion) values ('" & txtINITIALS & "','" & Replace(LabelApplicationVersion.Caption, "V ", "") & "')"
    CurrentProject.Connection.Execute sSql

Open in new window

Wondering if there is an easy way to handle all these, or will have to comment out all this code?

Also in a case where I do need the update to occur, how can I change the code to use another user, not the CurrentProject.Connection?

Thanks
0
Hello experts,
I have the following Input sheet.
I am looking for a procedure to cover the following requirement:
1-Remove Output Sheet if it exist
2-Transfert unique values of the following columns:
G (Tool)
 K(BU)
H (Action type)
I (Action)
Into output
3- Take as a reference the last 5TH current week 5 reported in column D
4-Perform the sum of unique transferred values
5-Insert subtotal for action type.
I attached Input and Output dummy file.
If you have questions, please contact me.
EE_follow_up.xlsx
0

Visual Basic Classic

164K

Solutions

58K

Contributors

Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.