I wrote a dll in Visual Basic on Visual Studio 2013 (what it does is irrelevant now):
Namespace TextFiles
Public Class ConfigTextFiles
'Library of functions to handle configuration text files holding pairs of parm-name, param-value.
'Param-name and Param-value are separated by the Delimiter property, or "=" if not set.
Shared strDelimiter As String
Shared intRowsCount As Integer
Public Shared Function getParamValue(ByVal strFileLocation As String, ByVal strFileName As String, ByVal strParamName As String) As String
'Return the value of a specific parameter within the text file
'Return an empty string if param-name is not found
'Return vbNullChar if file was not found
Dim TextLine() As String
Dim strFullFileName As String
If Right(strFileLocation, 1) = "\" Then
strFullFileName = strFileLocation & strFileName
Else
strFullFileName = strFileLocation & "\" & strFileName
End If
getParamValue = ""
If System.IO.File.Exists(strFullFileName) = True Then
If (IsNothing(strDelimiter)) Then strDelimiter = "="
Dim objReader As New System.IO.StreamReader(strFullFileName)
Do While objReader.Peek() <> -1
TextLine = Split(objReader.ReadLine(), strDelimiter)
If (Trim(strParamName) = Trim(TextLine(0))) Then
getParamValue = Trim(TextLine(1))
Exit Do
End If
Loop
objReader = Nothing
Else
MsgBox("File Does Not Exist: " & strFullFileName, MsgBoxStyle.OkOnly, "File Open Error")
getParamValue = vbNullChar
End If
End Function
End Class
End Namespace
This DLL is called: SisConfigTextFiles.dll and is stored in the folder of the executing (calling) (exe) file.
I want to explicitly link to it at runtime, from another Visual Basic application:
Public Class Initializing
Public Const CONFIG_FILE_NAME As String = "AppConfig.ini"
Public Shared Function getConfigParam(ParamName As String) As String
'Load external dll
Dim asm As Assembly = Assembly.Load("SisConfigTextFiles")
Dim type As Type = asm.GetType("TextFiles.ConfigTextFiles")
' Create an instance of a Type by calling Activator.CreateInstance
Dim dynamicObject As Object = Activator.CreateInstance(type)
Dim appPath As String = My.Application.Info.DirectoryPath
getConfigParam = ""
Dim returnValue = DirectCast(type.InvokeMember("getParamValue", _
BindingFlags.InvokeMethod Or BindingFlags.Static, _
Nothing, dynamicObject, {appPath, CONFIG_FILE_NAME, ParamName}), String)
getConfigParam = returnValue
End Function
End Class
However, I keep getting this runtime error:
System.ArgumentNullException: Value cannot be null.
Parameter name: type
Why is "type" Null? How can I straighten this out?
Thanks!
You are almost there but this line isnt valid:
asm.GetType("TextFiles.ConfigTextFiles")
It should be
asm.GetType("SisConfigTextFiles.TextFiles.ConfigTextFiles")
You can see the available types in the Assembly.ExportedTypes property.
Following Sam's advice, here's the fully working code that invokes a method in a DLL with late (run-time) binding:
Imports System.Reflection
Public Class Initializing
Public Const CONFIG_FILE_NAME As String = "AppConfig.ini"
Public Shared Sub Config_Init()
End Sub
Public Shared Function getConfigParam(ParamName As String) As String
'Load external dll
Dim asm As Assembly = Assembly.Load("SisConfigTextFiles")
Dim type As Type = asm.GetType("SisConfigTextFiles.TextFiles.ConfigTextFiles")
' Create an instance of a Type by calling Activator.CreateInstance
Dim dynamicObject As Object = Activator.CreateInstance(type)
Dim appPath As String = My.Application.Info.DirectoryPath
getConfigParam = ""
'Invoking a function "setParamValue" in the dll
Dim returnValue = DirectCast(type.InvokeMember("getParamValue", _
BindingFlags.InvokeMethod Or BindingFlags.Static Or BindingFlags.Public, _
Nothing, dynamicObject, {appPath, CONFIG_FILE_NAME, ParamName}), String)
getConfigParam = returnValue
End Function
End Class
Related
Firstly, I'm quite new to this so be gentle!
I am trying to create a class/object in VB.net for use in vba. I have used Gary Whitcher's code from the bottom of this post:
Sample vb.net code to upload file to Amazon S3 storage
I have created a class in Visual Studio and managed to get it to output a TLB file which i can import to VBA in Excel.
I can then use the object in VBA to create a new folder in the S3 storage system however I am running into problems when using the 'AddFileToFolder' method.
I have had to edit Gary's code a little to get it to compile in VS, the edited version is below.
Imports Amazon.S3
Imports Amazon.S3.Model
Imports Amazon
Imports Amazon.S3.Util
Imports System.Collections.ObjectModel
Imports System.IO
Public Class aws_s3
Const AWS_ACCESS_KEY As String = "AccessKey" 'is set to MY actual key
Const AWS_SECRET_KEY As String = "SecretKey" 'is set to MY actual key
Private Property s3Client As IAmazonS3
Sub New()
Try
s3Client = New AmazonS3Client(AWS_ACCESS_KEY, AWS_SECRET_KEY, RegionEndpoint.USEast1)
Catch ex As Exception
End Try
End Sub
Public Function CreateFolder(bucketName As String, folderName() As String) As String
Dim returnval As String = ""
Try
Try
Dim folderKey As String = ""
If Not AmazonS3Util.DoesS3BucketExist(s3Client, bucketName) Then
returnval = "Bucket does not exist"
Else
For i = 0 To folderName.Length - 1
folderKey += folderName(i) & "/"
Next
' folderKey = folderKey & "/" 'end the folder name with "/"
Dim request As PutObjectRequest = New PutObjectRequest()
request.BucketName = bucketName
request.StorageClass = S3StorageClass.Standard
request.ServerSideEncryptionMethod = ServerSideEncryptionMethod.None
' request.CannedACL = S3CannedACL.BucketOwnerFullControl
request.Key = folderKey
request.ContentBody = String.Empty
s3Client.PutObject(request)
End If
Catch ex As Exception
returnval = ex.Message
End Try
Catch ex As AmazonS3Exception
returnval = ex.Message
End Try
Return returnval
End Function
Public Function AddFileToFolder(FileName As String, bucketName As String, folderName As String) As String
Dim returnval As String = ""
Try
Try
If Not AmazonS3Util.DoesS3BucketExist(s3Client, bucketName) Then
Dim fname() As String = folderName.Split("/")
CreateFolder(bucketName, fname)
Else
Dim path As String = FileName
Dim file As FileInfo = New FileInfo(path)
Dim key As String = String.Format("{0}/{1}", folderName, file.Name)
Dim por As PutObjectRequest = New PutObjectRequest()
por.BucketName = bucketName
por.StorageClass = S3StorageClass.Standard
por.ServerSideEncryptionMethod = ServerSideEncryptionMethod.None
por.CannedACL = S3CannedACL.PublicRead
por.Key = key
por.InputStream = file.OpenRead()
s3Client.PutObject(por)
End If
Catch ex As Exception
returnval = ex.Message
End Try
Catch ex As AmazonS3Exception
returnval = ex.Message
End Try
Return returnval & " dll"
End Function
End Class
Using VBA, I have created the above object and can successfully execute CreateFolder but when executing addfiletofolder i get the error "Class does not support automation or does not support expected interface"
the VBA code looks like this:
Dim aws As AWS_S3
Dim Result As String
Dim UploadFile As String
UploadFile = "C:\Zipped Builds\Hinchley Legion.zip"
Set aws = New AWS_S3
Dim fld(1) As String
fld(0) = "folder"
fld(1) = "subfolder"
Result = aws.CreateFolder("nsmcustomercontent", fld)
If Result <> "" Then GoTo errHandle
Result = aws.AddFileToFolder(UploadFile, "nsmcustomercontent", fld)
If Result <> "" Then GoTo errHandle
Exit Sub
errHandle:
MsgBox Result
End Sub
I'm guessing from the fact that CreateFolder works fine but AddFileToFolder doesn't, there is a problem in the class as created in VS, missing a dependancy or something?
Thanks Anu6is, that was indeed the problem. The author of the class had wrote the following for usage which had thrown me off:
ADD FILE TO FOLDER
Dim fld(1) As String
fld(0) = <foldername>
fld(1) = <subfoldername>
'List each sub folder as an element in array
Dim rtrn As String = aws.AddFileToFolder(<local file name>,<bucketname>, fld)
I need to get better at reading VB.Net i think! Many thanks for your quick reply, much appreciated.
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
lblSystemSerialNumbers.Text = SystemSerialNumber()
lblCpuIds.Text = CpuId()
End Sub
Private Function SystemSerialNumber() As String
' Get the Windows Management Instrumentation object.
Dim wmi As Object = GetObject("WinMgmts:")
' Get the "base boards" (mother boards).
Dim serial_numbers As String = ""
Dim mother_boards As Object = wmi.InstancesOf("Win32_BaseBoard")
For Each board As Object In mother_boards
serial_numbers &= ", " & board.SerialNumber
Next board
If serial_numbers.Length > 0 Then serial_numbers = serial_numbers.Substring(2)
Return serial_numbers
End Function
Private Function CpuId() As String
Dim computer As String = "."
Dim wmi As Object = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
computer & "\root\cimv2")
Dim processors As Object = wmi.ExecQuery("Select * from Win32_Processor")
Dim cpu_ids As String = ""
For Each cpu As Object In processors
cpu_ids = cpu_ids & ", " & cpu.ProcessorId
Next cpu
If cpu_ids.Length > 0 Then cpu_ids = cpu_ids.Substring(2)
Return cpu_ids
End Function
End Class
This code will retrieve the CPU id and the motherboard id. How do I ensure that this will work even when option strict is on.
Why this could be a problem?
Well, let's see. The type of wmi is Object. That wmi do not necessarily support methods like InstancesOf, and SerialNumber
So how can we pull this out?
I think object that we got from GetObject is not just pure object. I think we should ctype or direct cast it to a more appropriate type. That more appropriate type will support methods like InstancesOf, SerialNumber, etc.
However what are the appropriate types?
You could use the ManagementObjectSearcher from the WMI classes hosted inside the System.Management.dll assembly.
(And you need to add the appropriate reference).
In this way you could write the SystemSerialNumber as
Private Function SystemSerialNumber(computer As String) As String
Dim wmi = New ManagementObjectSearcher(computer & "\root\cimv2", "select * from Win32_BaseBoard")
Dim boards = New List(Of String)()
For Each board In wmi.Get()
Dim temp = board.Properties("SerialNumber").Value?.ToString()
If Not String.IsNullOrEmpty(temp) Then
boards.Add(temp)
End If
Next board
Return String.Join(", ", boards)
End Function
The CpuId function is a bit more complex because you want to set the Impersonate flags but it is still possible to write a method around the NET wrapper classes for WMI interfaces
Private Function CpuId(computer As String) As String
Dim cpu = New List(Of String)()
Dim options = New ConnectionOptions()
options.Impersonation = System.Management.ImpersonationLevel.Impersonate
Dim scope = New ManagementScope(computer & "\root\cimv2", options)
scope.Connect()
Dim query = New ObjectQuery("Select * from Win32_Processor")
Dim wmi = New ManagementObjectSearcher(scope, query)
For Each m As ManagementObject In wmi.Get()
Dim temp = m.Properties("ProcessorId").Value?.ToString()
If Not String.IsNullOrEmpty(temp) Then
cpu.Add(temp)
End If
Next
Return String.Join(", ", cpu)
End Function
I have found answer to this question already in this post : https://stackoverflow.com/a/14711110/1764912
But my next query is, When I try to declare either a DataTable or MsgBox inside this dynamic code, it give me an error that "Type 'DataTable' is not defined" and "Type 'MsgBox' is not defined" is. If I add imports using either first line in dynamic code as :
Imports System.Data
or
Imports System.Data.DataTable
or if I use any of the following code in GenerateScript() function (Please refer https://stackoverflow.com/a/14711110/1764912 for GenerateScript() function)
Dim importDataNameSpace As String = GetType(DataTable).Namespace
Dim codeArray() As String = New String() {"Imports " & importDataNameSpace & Environment.NewLine & code}
or if I use
Dim codeArray() As String = New String() {"Imports System.Data" & Environment.NewLine & code}
or
Dim codeArray() As String = New String() {"Imports System.Data.DataTable" & Environment.NewLine & code}
In all above cases, it give me an error "System.Data does not contain any public members or couldn't found".
Importing namespaces does nothing for you unless you first also reference the library. If the library isn't referenced, then the namespace that you're importing will effectively be empty.
As others have mentioned in the comments above, just because you have the System.Data.dll library referenced in your project, that doesn't mean that it is also referenced by the assembly that you are dynamically compiling. Each assembly needs to directly reference all of the assemblies that it needs. Dynamically compiled assemblies are no exception.
References are added to the dynamic assembly via the CompilerParameters.ReferencedAssemblies.Add method. You can see an example of that in my answer to the question that you linked to. In that example, I had the dynamic assembly reference back to the main assembly so that it could use the IScript interface. You can, however, add as many references as you like. To also add a reference to System.Data.dll, you could do it like this:
Public Function GenerateScript(code As String) As IScript
Using provider As New VBCodeProvider()
Dim parameters As New CompilerParameters()
parameters.GenerateInMemory = True
parameters.ReferencedAssemblies.Add(Assembly.GetExecutingAssembly().Location)
parameters.ReferencedAssemblies.Add("System.Data.dll")
parameters.ReferencedAssemblies.Add("System.Xml.dll")
Dim interfaceNamespace As String = GetType(IScript).Namespace
Dim codeArray() As String = New String() {"Imports " & interfaceNamespace & Environment.NewLine & code}
Dim results As CompilerResults = provider.CompileAssemblyFromSource(parameters, codeArray)
If results.Errors.HasErrors Then
Throw New Exception("Failed to compile script")
Else
Return CType(results.CompiledAssembly.CreateInstance("Script"), IScript)
End If
End Using
End Function
Since the System.Data.dll assembly is in the GAC, you don't need to specify a full path. Notice also, that in order to use DataTable, you'll also need to add a reference to System.Xml.dll. You'd find that out as soon as you ran the code.
So, if you had the above method defined, and you had the following interface defined:
Public Interface IScript
Function DoWork() As String
End Interface
Then, you'd be able to call it like this:
Dim builder As New StringBuilder()
builder.AppendLine("Public Class Script")
builder.AppendLine(" Implements IScript")
builder.AppendLine(" Public Function DoWork() As String Implements IScript.DoWork")
builder.AppendLine(" Dim table As New System.Data.DataTable()")
builder.AppendLine(" table.TableName = ""Hello World""")
builder.AppendLine(" Return table.TableName")
builder.AppendLine(" End Function")
builder.AppendLine("End Class")
Dim script As IScript = GenerateScript(builder.ToString())
Console.WriteLine(script.DoWork()) ' Outputs "Hello World"
Example usage:
Eval("TextBox1.Text = TextBox1.Text")
The simplest and easiest.
'START EXECUTOR
Public Function Eval(ByVal vbCode As String) As Object
Dim c As VBCodeProvider = New VBCodeProvider
Dim icc As ICodeCompiler = c.CreateCompiler()
Dim cp As CompilerParameters = New CompilerParameters
cp.ReferencedAssemblies.Add("system.dll")
cp.ReferencedAssemblies.Add("system.xml.dll")
cp.ReferencedAssemblies.Add("system.data.dll")
' Sample code for adding your own referenced assemblies
'cp.ReferencedAssemblies.Add("c:\yourProjectDir\bin\YourBaseClass.dll")
'cp.ReferencedAssemblies.Add("YourBaseclass.dll")
cp.CompilerOptions = "/t:library"
cp.GenerateInMemory = True
Dim sb As StringBuilder = New StringBuilder("")
sb.Append("Imports System" & vbCrLf)
sb.Append("Imports System.Xml" & vbCrLf)
sb.Append("Imports System.Data" & vbCrLf)
sb.Append("Imports System.Data.SqlClient" & vbCrLf)
sb.Append("Namespace PAB " & vbCrLf)
sb.Append("Class PABLib " & vbCrLf)
sb.Append("public function EvalCode() as Object " & vbCrLf)
'sb.Append("YourNamespace.YourBaseClass thisObject = New YourNamespace.YourBaseClass()")
sb.Append(vbCode & vbCrLf)
sb.Append("End Function " & vbCrLf)
sb.Append("End Class " & vbCrLf)
sb.Append("End Namespace" & vbCrLf)
Debug.WriteLine(sb.ToString()) ' look at this to debug your eval string
Dim cr As CompilerResults = icc.CompileAssemblyFromSource(cp, sb.ToString())
Dim a As System.Reflection.Assembly = cr.CompiledAssembly
Dim o As Object
Dim mi As MethodInfo
o = a.CreateInstance("PAB.PABLib")
Dim t As Type = o.GetType()
mi = t.GetMethod("EvalCode")
Dim s As Object
s = mi.Invoke(o, Nothing)
Return s
End Function
'END EXECUTOR
Don't forget the imports:
Imports Microsoft.VisualBasic
Imports System
Imports System.Text
Imports System.CodeDom.Compiler
Imports System.Reflection
I have an MS Access database which now requires me to 'attach' documents to it. My intention is to store the documents on Google Drive and have a link on the database for users to retrieve the documents.
As there are many users spread through different cities, it is not practical to require them to have synced Google Drive folders. All the users will need the ability to upload to the database/GD so my intention is to have a separate Google account for the database - with its own login details.
example:
User clicks button to upload file
Save as dialog box appears and user selects file
Database logs into its Google Drive and uploads selected file
Lots of problems with this though, the main one being that Google Drive does not support VBA.
If the user is logged into their own Gmail account, that will probably be another issue.
I came across this code for vb.net on another site.
Imports System
Imports System.Diagnostics
Imports DotNetOpenAuth.OAuth2
Imports Google.Apis.Authentication.OAuth2
Imports Google.Apis.Authentication.OAuth2.DotNetOpenAuth
Imports Google.Apis.Drive.v2
Imports Google.Apis.Drive.v2.Data
Imports Google.Apis.Util
Imports Google.Apis.Services
Namespace GoogleDriveSamples
Class DriveCommandLineSample
Shared Sub Main(ByVal args As String)
Dim CLIENT_ID As [String] = "YOUR_CLIENT_ID"
Dim CLIENT_SECRET As [String] = "YOUR_CLIENT_SECRET"
'' Register the authenticator and create the service
Dim provider = New NativeApplicationClient(GoogleAuthenticationServer.Description, CLIENT_ID, CLIENT_SECRET)
Dim auth = New OAuth2Authenticator(Of NativeApplicationClient)(provider, GetAuthorization)
Dim service = New DriveService(New BaseClientService.Initializer() With { _
.Authenticator = auth _
})
Dim body As New File()
body.Title = "My document"
body.Description = "A test document"
body.MimeType = "text/plain"
Dim byteArray As Byte() = System.IO.File.ReadAllBytes("document.txt")
Dim stream As New System.IO.MemoryStream(byteArray)
Dim request As FilesResource.InsertMediaUpload = service.Files.Insert(body, stream, "text/plain")
request.Upload()
Dim file As File = request.ResponseBody
Console.WriteLine("File id: " + file.Id)
Console.WriteLine("Press Enter to end this process.")
Console.ReadLine()
End Sub
Private Shared Function GetAuthorization(ByVal arg As NativeApplicationClient) As IAuthorizationState
' Get the auth URL:
Dim state As IAuthorizationState = New AuthorizationState( New () {DriveService.Scopes.Drive.GetStringValue()})
state.Callback = New Uri(NativeApplicationClient.OutOfBandCallbackUrl)
Dim authUri As Uri = arg.RequestUserAuthorization(state)
' Request authorization from the user (by opening a browser window):
Process.Start(authUri.ToString())
Console.Write(" Authorization Code: ")
Dim authCode As String = Console.ReadLine()
Console.WriteLine()
' Retrieve the access token by using the authorization code:
Return arg.ProcessUserAuthorization(authCode, state)
End Function
End Class
End Namespace
It was suggested that the IE library could be utilised to log into the Google Drive and the API calls made from the above to upload. I don't know how to do this. Somewhere else it was mentioned that a 'COM wrapper' may be suitable. I don't have experience with any coding other than VBA (self taught) so am struggling to understand what the next step should be.
If anyone has done something similar or can offer any advice, I would be grateful to hear from you.
This thread might be dead now but if you are working with forms in your database and the user needs to be attaching the files to a particular record displayed in a form with a unique identification number then this is definitely possible but you would have to do it in an external application written in .NET I can provide you with the necessary code to get you started, vb.net is very similar to VBA.
What you would need to do is create a windows form project and add references to Microsoft access core dll and download the nugget package for google drive api from nugget.
Imports Google
Imports Google.Apis.Services
Imports Google.Apis.Drive.v2
Imports Google.Apis.Auth.OAuth2
Imports Google.Apis.Drive.v2.Data
Imports System.Threading
Public Class GoogleDriveAuth
Public Shared Function GetAuthentication() As DriveService
Dim ClientIDString As String = "Your Client ID"
Dim ClientSecretString As String = "Your Client Secret"
Dim ApplicationNameString As String = "Your Application Name"
Dim secrets = New ClientSecrets()
secrets.ClientId = ClientIDString
secrets.ClientSecret = ClientSecretString
Dim scope = New List(Of String)
scope.Add(DriveService.Scope.Drive)
Dim credential = GoogleWebAuthorizationBroker.AuthorizeAsync(secrets, scope, "user", CancellationToken.None).Result()
Dim initializer = New BaseClientService.Initializer
initializer.HttpClientInitializer = credential
initializer.ApplicationName = ApplicationNameString
Dim Service = New DriveService(initializer)
Return Service
End Function
End Class
This code will authorise your drive service then you create a Public Shared Service As DriveService under your imports that can be used from any sub or function then call this function on your form load event like
Service = GoogleDriveAuth.GetAuthentication
Add a reference to your project to Microsoft Access 12.0 Object Library or whatever version you have
Then this piece of code will look at the form you want to get the value of the record no from and upload a file to your choice of folder
Private Sub UploadAttachments()
Dim NumberExtracted As String
Dim oAccess As Microsoft.Office.Interop.Access.Application = Nothing
Dim connectedToAccess As Boolean = False
Dim SelectedFolderIdent As String = "Your Upload Folder ID"
Dim CreatedFolderIdent As String
Dim tryToConnect As Boolean = True
Dim oForm As Microsoft.Office.Interop.Access.Form
Dim oCtls As Microsoft.Office.Interop.Access.Controls
Dim oCtl As Microsoft.Office.Interop.Access.Control
Dim sForm As String 'name of form to show
sForm = "Your Form Name"
Try
While tryToConnect
Try
' See if can connect to a running Access instance
oAccess = CType(Marshal.GetActiveObject("Access.Application"), Microsoft.Office.Interop.Access.Application)
connectedToAccess = True
Catch ex As Exception
Try
' If couldn't connect to running instance of Access try to start a running Access instance And get an updated version of the database
oAccess = CType(CreateObject("Access.Application"), Microsoft.Office.Interop.Access.Application)
oAccess.Visible = True
oAccess.OpenCurrentDatabase("Your Database Path", False)
connectedToAccess = True
Catch ex2 As Exception
Dim res As DialogResult = MessageBox.Show("COULD NOT CONNECT TO OR START THE DATABASE" & vbNewLine & ex2.Message, "Warning", MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.Warning)
If res = System.Windows.Forms.DialogResult.Abort Then
Exit Sub
End If
If res = System.Windows.Forms.DialogResult.Ignore Then
tryToConnect = False
End If
End Try
End Try
' We have connected successfully; stop trying
tryToConnect = False
End While
' Start a new instance of Access for Automation:
' Make sure Access is visible:
If Not oAccess.Visible Then oAccess.Visible = True
' For Each oForm In oAccess.Forms
' oAccess.DoCmd.Close(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=oForm.Name, Save:=Microsoft.Office.Interop.Access.AcCloseSave.acSaveNo)
' Next
' If Not oForm Is Nothing Then
' System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
' End If
' oForm = Nothing
' Select the form name in the database window and give focus
' to the database window:
' oAccess.DoCmd.SelectObject(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=sForm, InDatabaseWindow:=True)
' Show the form:
' oAccess.DoCmd.OpenForm(FormName:=sForm, View:=Microsoft.Office.Interop.Access.AcFormView.acNormal)
' Use Controls collection to edit the form:
oForm = oAccess.Forms(sForm)
oCtls = oForm.Controls
oCtl = oCtls.Item("The Name Of The Control Where The Id Number Is On The Form")
oCtl.Enabled = True
' oCtl.SetFocus()
NumberExtracted = oCtl.Value
System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtl)
oCtl = Nothing
' Hide the Database Window:
' oAccess.DoCmd.SelectObject(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=sForm, InDatabaseWindow:=True)
' oAccess.RunCommand(Command:=Microsoft.Office.Interop.Access.AcCommand.acCmdWindowHide)
' Set focus back to the form:
' oForm.SetFocus()
' Release Controls and Form objects:
System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtls)
oCtls = Nothing
System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
oForm = Nothing
' Release Application object and allow Access to be closed by user:
If Not oAccess.UserControl Then oAccess.UserControl = True
System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
oAccess = Nothing
If NumberExtracted = Nothing Then
MsgBox("The Number Could Not Be Obtained From The Form" & vbNewLine & vbNewLine & "Please Ensure You Have The Form Open Before Trying To Upload")
Exit Sub
End If
If CheckForDuplicateFolder(SelectedFolderIdent, NumberExtracted + " - ATC") = True Then
CreatedFolderIdent = GetCreatedFolderID(NumberExtracted + " - ATC", SelectedFolderIdent)
DriveFilePickerUploader(CreatedFolderIdent)
Else
CreateNewDriveFolder(NumberExtracted + " - ATC", SelectedFolderIdent)
CreatedFolderIdent = GetCreatedFolderID(NumberExtracted + " - ATC", SelectedFolderIdent)
DriveFilePickerUploader(CreatedFolderIdent)
End If
Catch EX As Exception
MsgBox("The Number Could Not Be Obtained From The Form" & vbNewLine & vbNewLine & "Please Ensure You Have The Form Open Before Trying To Upload" & vbNewLine & vbNewLine & EX.Message)
Exit Sub
Finally
If Not oCtls Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtls)
oCtls = Nothing
End If
If Not oForm Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
oForm = Nothing
End If
If Not oAccess Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
oAccess = Nothing
End If
End Try
End
End Sub
Check For Duplicate Folders In The Destination Upload Folder
Public Function CheckForDuplicateFolder(ByVal FolderID As String, ByVal NewFolderNameToCheck As String) As Boolean
Dim ResultToReturn As Boolean = False
Try
Dim request = Service.Files.List()
Dim requeststring As String = ("'" & FolderID & "' in parents And mimeType='application/vnd.google-apps.folder' And trashed=false")
request.Q = requeststring
Dim FileList = request.Execute()
For Each File In FileList.Items
If File.Title = NewFolderNameToCheck Then
ResultToReturn = True
End If
Next
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
Return ResultToReturn
End Function
Create New Drive Folder
Public Sub CreateNewDriveFolder(ByVal DirectoryName As String, ByVal ParentFolder As String)
Try
Dim body1 = New Google.Apis.Drive.v2.Data.File
body1.Title = DirectoryName
body1.Description = "Created By Automation"
body1.MimeType = "application/vnd.google-apps.folder"
body1.Parents = New List(Of ParentReference)() From {New ParentReference() With {.Id = ParentFolder}}
Dim file1 As Google.Apis.Drive.v2.Data.File = Service.Files.Insert(body1).Execute()
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
End Sub
Get The Created Folder ID
Public Function GetCreatedFolderID(ByVal FolderName As String, ByVal FolderID As String) As String
Dim ParentFolder As String
Try
Dim request = Service.Files.List()
Dim requeststring As String = ("'" & FolderID & "' in parents And mimeType='application/vnd.google-apps.folder' And title='" & FolderName & "' And trashed=false")
request.Q = requeststring
Dim Parent = request.Execute()
ParentFolder = (Parent.Items(0).Id)
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
Return ParentFolder
End Function
Drive File Picker Uploader To Upload Files Selected From A File Dialog Box To The Newly Created Folder
Public Sub DriveFilePickerUploader(ByVal ParentFolderID As String)
Try
ProgressBar1.Value = 0
Dim MimeTypeToUse As String
Dim dr As DialogResult = Me.OpenFileDialog1.ShowDialog()
If (dr = System.Windows.Forms.DialogResult.OK) Then
Dim file As String
Else : Exit Sub
End If
Dim i As Integer = 0
For Each file In OpenFileDialog1.FileNames
MimeTypeToUse = GetMimeType(file)
Dim filetitle As String = (OpenFileDialog1.SafeFileNames(i))
Dim body2 = New Google.Apis.Drive.v2.Data.File
body2.Title = filetitle
body2.Description = "J-T Auto File Uploader"
body2.MimeType = MimeTypeToUse
body2.Parents = New List(Of ParentReference)() From {New ParentReference() With {.Id = ParentFolderID}}
Dim byteArray = System.IO.File.ReadAllBytes(file)
Dim stream = New System.IO.MemoryStream(byteArray)
Dim request2 = Service.Files.Insert(body2, stream, MimeTypeToUse)
request2.Upload()
Next
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
End Sub
Get The Mime Type Of The Files Being Uploaded
Public Shared Function GetMimeType(ByVal file As String) As String
Dim mime As String = Nothing
Dim MaxContent As Integer = CInt(New FileInfo(file).Length)
If MaxContent > 4096 Then
MaxContent = 4096
End If
Dim fs As New FileStream(file, FileMode.Open)
Dim buf(MaxContent) As Byte
fs.Read(buf, 0, MaxContent)
fs.Close()
Dim result As Integer = FindMimeFromData(IntPtr.Zero, file, buf, MaxContent, Nothing, 0, mime, 0)
Return mime
End Function
<DllImport("urlmon.dll", CharSet:=CharSet.Auto)> _
Private Shared Function FindMimeFromData( _
ByVal pBC As IntPtr, _
<MarshalAs(UnmanagedType.LPWStr)> _
ByVal pwzUrl As String, _
<MarshalAs(UnmanagedType.LPArray, ArraySubType:=UnmanagedType.I1, SizeParamIndex:=3)> ByVal _
pBuffer As Byte(), _
ByVal cbSize As Integer, _
<MarshalAs(UnmanagedType.LPWStr)> _
ByVal pwzMimeProposed As String, _
ByVal dwMimeFlags As Integer, _
<MarshalAs(UnmanagedType.LPWStr)> _
ByRef ppwzMimeOut As String, _
ByVal dwReserved As Integer) As Integer
End Function
Hopefully this helps you make a start I am 100% convinced this is achievable as I have already done this for my manager.
This reply might be late but just wanna share one of the approach!
I have done this successfully with VBA and the demo link is here
http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1
With this, you can upload, download or delete a file with your GoogleDrive in Access..
Just Wininet + WinHTTP enough
Dang Dinh ngoc
Vietnam
How can I get the resulting generated list of links sorted out alphabetically according to "sTitle"? My sort function on line 272 is not giving me the results I need. Please help.
<script language="VB" runat="server">
Function sectionTitle(ByRef f As String)
'Open a file for reading
'Dim FILENAME As String = Server.MapPath("index.asp")
Dim FILENAME As String = f
'Get a StreamReader class that can be used to read the file
Dim objStreamReader As StreamReader
objStreamReader = File.OpenText(FILENAME)
'Now, read the entire file into a string
Dim contents As String = objStreamReader.ReadToEnd()
'search string for <title>some words</title>
Dim resultText As Match = Regex.Match(contents, "(<title>(?<t>.*?)</title>)")
'put result into new string
Dim HtmlTitle As String = resultText.Groups("t").Value
Return HtmlTitle
' If HtmlTitle <> "" Then
'Response.Write(HtmlTitle)
' Else
'Response.Write("<ul><li>b: " & contents & "</a></li></ul>")
' End If
End Function
Public Class linkItem
Public myName As String
Public myValue As String
Public Sub New(ByVal myName As String, ByVal myValue As String)
Me.myName = myName
Me.myValue = myValue
End Sub 'New
End Class 'linkItem
Sub DirSearch(ByVal sDir As String)
Dim d As String
Dim f As String
Dim mylist As New List(Of linkItem)
Try
For Each d In Directory.GetDirectories(sDir)
'Response.Write("test c")
For Each f In Directory.GetFiles("" & d & "", "index.asp")
'Response.Write("test a")
Dim sTitle As String = sectionTitle(f)
'remove wilbur wright college - from sTitle string
sTitle = Regex.Replace(sTitle, "My College - ", "")
'print section title - must come before search n replace string
f = Regex.Replace(f, "C:\\inetpub\\wwwroot\\mypath\\", "")
'add to list
mylist.Add(New linkItem(f, sTitle))
'print links as list
'Response.Write("<ul><li><a href='" & f & "'>" & sTitle & "</a></li></ul>")
Next
DirSearch(d)
Next
Catch excpt As System.Exception
'Response.Write("test b")
Response.Write(excpt.Message)
End Try
mylist.Sort(Function(p1, p2) p1.myValue.CompareTo(p2.myValue))
mylist.ForEach(AddressOf ProcessLink)
End Sub
Sub ProcessLink(ByVal P As linkItem)
If (True) Then
Response.Write("<ul><li><a href='" & P.myName & "'>" & P.myValue & "</a></li></ul>")
End If
End Sub
</script>
<%
'Dim sDir As New DirectoryInfo(Server.MapPath(""))
Call DirSearch((Server.MapPath("")))
%>
Check out the IComparable interface to help with this.
Basically, you need to teach your program what to use as a comparison point of reference for your class.
IComparable will allow you to make use of the CompareTo() method.
Here's the sample code if you're interested:
Public Class Temperature
Implements IComparable
Public Overloads Function CompareTo(ByVal obj As Object) As Integer _
Implements IComparable.CompareTo
If TypeOf obj Is Temperature Then
Dim temp As Temperature = CType(obj, Temperature)
Return m_value.CompareTo(temp.m_value)
End If
Throw New ArgumentException("object is not a Temperature")
End Function
' The value holder
Protected m_value As Integer
Public Property Value() As Integer
Get
Return m_value
End Get
Set(ByVal Value As Integer)
m_value = Value
End Set
End Property
Public Property Celsius() As Integer
Get
Return (m_value - 32) / 2
End Get
Set(ByVal Value As Integer)
m_value = Value * 2 + 32
End Set
End Property
End Class