Is there any other way on how to refine my code?
Sub save_item(ByVal strtype As String, ByVal strgendes As String, ByVal strquantity As String, ByVal strfund As String, ByVal strebudget As String, _
ByVal strtotaltenpercent As String, ByVal strjan As String, ByVal strfeb As String, ByVal strmarch As String, _
ByVal strapril As String, ByVal strmay As String, ByVal strjune As String, ByVal strjuly As String, _
ByVal straug As String, ByVal strsept As String, ByVal stroct As String, ByVal strnov As String, ByVal strdec As String, _
ByVal strq1 As String, ByVal strq2 As String, ByVal strq3 As String, ByVal strq4 As String, ByVal strtotal_item As String,
_
ByVal strtotalprice As String, ByVal strdate As String, ByVal stryear As String)
Dim saveall As New tblPPMP With {.Type = strtype, _
.GenDes = strgendes, _
.Quantity = strquantity, _
.Fund = strfund, _
.Ebudget = strebudget, _
.Total_tenpercent = strtotaltenpercent, _
.Jan = strjan, _
.Feb = strfeb, _
.March = strmarch, _
.April = strapril, _
.May = strmay, _
.June = strjune, _
.Jul = strjuly, _
.Aug = straug, _
.Sept = strsept, _
.Oct = stroct, _
.Nov = strnov, _
.Dec = strdec, _
.Q1 = strq1, _
.Q2 = strq2, _
.Q3 = strq3, _
.Q4 = strq4, _
.Total_Item = strtotal_item, _
.Total_Price = strtotalprice, _
.dr_date = strdate, _
.dr_year = stryear}
dbcon.tblPPMPs.InsertOnSubmit(saveall)
MsgBox("Save Successfully")
Try
dbcon.SubmitChanges()
Catch ex As Exception
End Try
End Sub
Catching and then throwing a new Exception seems pointless. Remove that.
Related
What i want :
to a make a button that exports the selected data in this FelxGrid into .ini file format take (heights) as section and the others as values and keys , it dosen't have to be ini format it can also be something close to it
What i tried so far
Private Sub commandbutton_1()
Dim configfile As String
Dim myArray() As String 'i tried using arry but it didn't work
configfile = "C:\" & "\CONFIGMEEE!.INI"
PutINISetting "", "", SettingsGrid.Clip, configfile
MsgBox "Exported.", vbInformation, "Settings"
SettingsGrid.SaveGrid configfile, flexFileTabText
What happened then
the data we exported but not formatted at all as ini and written so :
Important to know
The flexgrid iam using is a vsflexgrid not an msflexgrid
And i am also using this as a MOUDLE
'API Function to write information to the INI File
Private Declare Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long
'Get the INI Setting from the File
Public Function GetINISetting(ByVal sHeading As String, _
ByVal sKey As String, _
sINIFileName) As String
Const cparmLen = 50
Dim sReturn As String * cparmLen
Dim sDefault As String * cparmLen
Dim lLength As Long
lLength = GetPrivateProfileString(sHeading, _
sKey, _
sDefault, _
sReturn, _
cparmLen, _
sINIFileName)
GetINISetting = Mid(sReturn, 1, lLength)
End Function
'Save INI Setting in the File
Public Function PutINISetting(ByVal sHeading As String, _
ByVal sKey As String, _
ByVal sSetting As String, _
sINIFileName) As Boolean
Const cparmLen = 50
Dim sReturn As String * cparmLen
Dim sDefault As String * cparmLen
Dim aLength As Long
aLength = WritePrivateProfileString(sHeading, _
sKey, _
sSetting, _
sINIFileName)
PutINISetting = True
End Function
I am trying to save an image from a webpage using excel vba.
I'm managed to get the string (although not the one I want), and need to save it to disk.
The HTML code for the source is:
<img id="SkuPageMainImg" data-sku="491215" alt="Papir ubleket kraft 60g 40cm 5kg/rull" class="skuImageSTD" src="/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA" data-zoomimage="//www.staples.no/content/images/product/491215_1_xnl.jpg" data-resizeimage="{"0to1024":"/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA","1025to1450":"//www.staples.no/content/images/product/491215_1"}" data-screensize="">
My code is: IMG = .document.getElementById("SkuPageMainImg").src
This code captures the url after the src= :
/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA"
This will do, but what i would preffer to catch is the url after data-zoomimage= :
"//www.staples.no/content/images/product/491215_1_xnl.jpg"
Either way, what I am looking to accomplish is having Excel VBA save the image to a file on my disk - typically c:\folder\image_name.jpg
Anybody know the code to do this?
Import the URLDownloadToFile function and use it directly. The following is an entire module code sheet, including the declarations section at the top. The routine expects a list of the full img src URLs in column A starting at row 2. e.g.: http://www.staples.no/content/images/product/491215_1_xnm.jpg
Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long
#End If
Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000
Sub dlStaplesImages()
Dim rw As Long, lr As Long, ret As Long, sIMGDIR As String, sWAN As String, sLAN As String
sIMGDIR = "c:\folder"
If Dir(sIMGDIR, vbDirectory) = "" Then MkDir sIMGDIR
With ActiveSheet '<-set this worksheet reference properly!
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For rw = 2 To lr
sWAN = .Cells(rw, 1).Value2
sLAN = sIMGDIR & Chr(92) & Trim(Right(Replace(sWAN, Chr(47), Space(999)), 999))
Debug.Print sWAN
Debug.Print sLAN
If CBool(Len(Dir(sLAN))) Then
Call DeleteUrlCacheEntry(sLAN)
Kill sLAN
End If
ret = URLDownloadToFile(0&, sWAN, sLAN, BINDF_GETNEWESTVERSION, 0&)
.Cells(rw, 2) = ret
Next rw
End With
End Sub
A value of 0 is column B indicates success (e.g. ERROR_SUCCESS).
I have a xls/csv list of images:
Name image url
test.jpg http://test.com/232dd.jpg
test2.jpg http://test.com/2390j.jpg
I have about 200 of these...is there a way to download the list and name them as identified in the xls file?
Here is my Excel VBA:
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Sub download_pics()
Dim rng As Range
Dim cell As Variant
Set rng = Range("A1:B10")
For Each cell In rng
' Download the file.
URLDownloadToFile 0, cell(rng, 2).Value, "C:\" & cell(rng, 1).Value, 0, 0
Next
End Sub
Running into type mismatch error with URLDownloadToFile
OK The type mismatch has to do with your iteration. You need to specify how you're iterating over rng with the For each cell in rng statement, like:
For each cell in rng.Rows
Otherwise, it treats that statement as For each cell in rng.Cells and that raises the mismatch error.
I made some modifications to the code (based on Sid's answer here), so it checks to ensure the file downloaded successfully, but mostly what you found was correct, you just need to implement it a little differently.
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Sub download_pics()
Dim rng As Range
Dim myRow As Range
Dim imgName As String
Dim fileLocation As String
Dim Ret As Long 'return value from the URLDownloadToFile function
Set rng = Range("A1:B10")
For Each myRow In rng.Rows
With myRow
imgName = .Columns(2).Value
fileLocation = "C:\" & .Columns(1).Value
With .Columns(1).Offset(, 2)
If URLDownloadToFile(0, imgName, fileLocation, 0, 0) = 0 Then
.Value = "downloaded successfully"
Else:
.Value = "download failed!"
End If
End With
End With
Next
End Sub
I've found a way to get hdd serial no in vb6. But it needs to select an option from
primary master
primary slave
secondary master
secondary slave
But I want to auto select an option. The auto select logic is,
suppose I've 4 HDD with the above 4 types. And the logic will select the hdd type, on which the current system is loaded.
I really have no idea how to detect the current system is on which HDD type. Please help.
Here is the class that I use to select HDD serial no. HDSN CLASS
The code below should help:
Option Explicit
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const IOCTL_VOLUME_BASE As Long = 86 ' Asc("V")
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_READ_ACCESS As Long = 1
Private Const FILE_ANY_ACCESS As Long = 0
'DEFINE IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS CTL_CODE(IOCTL_VOLUME_BASE, 0, METHOD_BUFFERED, FILE_ANY_ACCESS)
Private Const IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = (((IOCTL_VOLUME_BASE) * (2& ^ 16&)) Or ((FILE_ANY_ACCESS) * (2& ^ 14&)) Or ((0&) * (2& ^ 2&)) Or (METHOD_BUFFERED))
Private Type DISK_EXTENT
DiskNumber As Long
StartingOffset As Currency
ExtentLength As Currency
End Type
Private Type VOLUME_DISK_EXTENTS
NumberOfDiskExtents As Currency
Extents(1 To 4) As DISK_EXTENT
End Type
Private Declare Function CreateFile _
Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32.dll" Alias "GetWindowsDirectoryW" ( _
ByVal lpBuffer As Long, _
ByVal uSize As Long _
) As Long
Private Declare Function DeviceIoControlNoInput _
Lib "kernel32" Alias "DeviceIoControl" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
ByVal lpInBuffer As Long, _
ByVal nInBufferSize As Long, _
ByRef lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
ByRef lpBytesReturned As Long, _
ByVal lpOverlapped As Long) As Long
' Return the index of the physical drive from which we've booted into Windows.
Public Function GetBootPhysicalDrive() As Long
Dim sWindowsPath As String
Dim nRet As Long
Dim sDevicePath As String
Dim hLogicalBootDrive As Long
Dim sVolumeDevice As String
Dim uVolumeDiskExtents As VOLUME_DISK_EXTENTS
Dim nBytesReturned As Long
' Allocate space and retrieve the windows directory.
sWindowsPath = Space$(64)
nRet = GetWindowsDirectory(StrPtr(sWindowsPath), 64)
' This gives us the volume that Windows is on. Open it.
sVolumeDevice = "\\.\" & Left$(sWindowsPath, 2)
hLogicalBootDrive = CreateFile(sVolumeDevice, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
' Find out information about this volume.
nRet = DeviceIoControlNoInput(hLogicalBootDrive, IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, 0&, 0&, uVolumeDiskExtents, LenB(uVolumeDiskExtents), nBytesReturned, 0&)
If nRet = 0 Then
' Something went wrong. Return error value.
GetBootPhysicalDrive = -1
Else
' This is the physical disk number.
GetBootPhysicalDrive = uVolumeDiskExtents.Extents(1).DiskNumber
End If
' Close volume.
CloseHandle hLogicalBootDrive
End Function
Using theAbove Solution of Mark Bertenshaw I wrote the following in a module and just called the GetDiskSerialNumber function to get serial of the HDD from which the current system is Booted. Here is my module code:
Option Explicit
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const IOCTL_VOLUME_BASE As Long = 86 ' Asc("V")
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_READ_ACCESS As Long = 1
Private Const FILE_ANY_ACCESS As Long = 0
'DEFINE IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS CTL_CODE(IOCTL_VOLUME_BASE, 0, METHOD_BUFFERED, FILE_ANY_ACCESS)
Private Const IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = (((IOCTL_VOLUME_BASE) * (2& ^ 16&)) Or ((FILE_ANY_ACCESS) * (2& ^ 14&)) Or ((0&) * (2& ^ 2&)) Or (METHOD_BUFFERED))
Private Type DISK_EXTENT
DiskNumber As Long
StartingOffset As Currency
ExtentLength As Currency
End Type
Private Type VOLUME_DISK_EXTENTS
NumberOfDiskExtents As Currency
Extents(1 To 4) As DISK_EXTENT
End Type
Private Declare Function CreateFile _
Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32.dll" Alias "GetWindowsDirectoryW" ( _
ByVal lpBuffer As Long, _
ByVal uSize As Long _
) As Long
Private Declare Function DeviceIoControlNoInput _
Lib "kernel32" Alias "DeviceIoControl" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
ByVal lpInBuffer As Long, _
ByVal nInBufferSize As Long, _
ByRef lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
ByRef lpBytesReturned As Long, _
ByVal lpOverlapped As Long) As Long
' Return the index of the physical drive from which we've booted into Windows.
Public Function GetBootPhysicalDrive() As Long
Dim sWindowsPath As String
Dim nRet As Long
Dim sDevicePath As String
Dim hLogicalBootDrive As Long
Dim sVolumeDevice As String
Dim uVolumeDiskExtents As VOLUME_DISK_EXTENTS
Dim nBytesReturned As Long
' Allocate space and retrieve the windows directory.
sWindowsPath = Space$(64)
nRet = GetWindowsDirectory(StrPtr(sWindowsPath), 64)
' This gives us the volume that Windows is on. Open it.
sVolumeDevice = "\\.\" & Left$(sWindowsPath, 2)
hLogicalBootDrive = CreateFile(sVolumeDevice, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
' Find out information about this volume.
nRet = DeviceIoControlNoInput(hLogicalBootDrive, IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, 0&, 0&, uVolumeDiskExtents, LenB(uVolumeDiskExtents), nBytesReturned, 0&)
If nRet = 0 Then
' Something went wrong. Return error value.
GetBootPhysicalDrive = -1
Else
' This is the physical disk number.
GetBootPhysicalDrive = uVolumeDiskExtents.Extents(1).DiskNumber
End If
' Close volume.
CloseHandle hLogicalBootDrive
End Function
Public Function GetDiskSerialNumber() As String
Dim wmiObject As Object
Dim obj As Object
Set wmiObject = GetObject("WinMgmts:")
For Each obj In wmiObject.InstancesOf("Win32_PhysicalMedia")
If obj.Tag = "\\.\PHYSICALDRIVE" + CStr(GetBootPhysicalDrive) Then GetDiskSerialNumber = obj.Tag + " : " + obj.SerialNumber
Next obj
End Function
Many thanks to Mark Bertenshaw.
can anyone help me convert this to autoit, or at least tell me how i can do this in autoit?
Private Const DC_PAPERNAMES = 16
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesW" ( _
ByVal lpDeviceName As Long, _
ByVal lpPort As Long, _
ByVal iIndex As Long, _
ByVal lpOutput As Long, _
ByVal lpDevMode As Long) As Long
Private Sub Form_Load()
Dim P As Printer
For Each P In Printers
lstPrinters.AddItem P.DeviceName
Next
End Sub
Private Sub lstPrinters_Click()
Dim P As Printer
Dim lngPapers As Long
Dim strPaperNames As String
Dim lngPaper As Long
Dim strPaperName As String
Dim lngActualLength As Long
Set P = Printers(lstPrinters.ListIndex)
lngPapers = DeviceCapabilities(StrPtr(P.DeviceName), _
StrPtr(P.Port), _
DC_PAPERNAMES, _
0, _
0)
strPaperNames = String$(lngPapers * 64, 0)
lngPapers = DeviceCapabilities(StrPtr(P.DeviceName), _
StrPtr(P.Port), _
DC_PAPERNAMES, _
StrPtr(strPaperNames), _
0)
lstPapers.Clear
For lngPaper = 0 To lngPapers - 1
strPaperName = Mid$(strPaperNames, 64 * lngPaper + 1, 64)
lngActualLength = InStr(strPaperName, vbNullChar) - 1
If lngActualLength > 1 Then strPaperName = Left$(strPaperName, lngActualLength)
lstPapers.AddItem strPaperName
Next
End Sub
Here's a thread where someone is trying to do the exact same thing: http://www.autoitscript.com/forum/topic/25857-need-a-help-from-the-pros-on-making-api-call/
There is also a guide which will help you write windows API calls: http://www.autoitscript.com/forum/topic/7072-dllcall/ it deals mainly with finding the correct type conversion which is the only hard part.