I have an access database (Office 365) that stores the filepath of sample reports in a table "Samples". Field is short text, "SampleFilePath" I build the filename in code and attempt the following:
Dim worddoc As String
Dim reportpath As String
Dim filename As String
worddoc = "C:\testdir\Customer\sample.docx"
command = "Explorer.exe " & worddoc
VBA.Shell command ' THIS WORKS!!! Word doc opens.
'Note: reportpath and filename are retrieved from table with Dlookup, successfully.
worddoc = reportpath & "\" & filename
command = "Explorer.exe " & worddoc
VBA.Shell command ' This doesn't work! Nothing happens.
Is this based on how the reportpath and filename are stored in the table, as short-text? I am suspicious that it has something to do with quotation marks. Thanks for the help!
Related
I'm really new to Access so I haven't heard of most of the commands for Access VBA, but I am pretty familiar with Excel VBA.
What I'm trying to do is save the attachment that was just entered into a table through a form. I've been looking at some examples online and trying to get it to work for me but the code is not moving the file to the folder. I do not get a debug error though.
Here is my current code. I know it is set to loop right now, where really I just want the last attachment in the table each time, but I don't know how to get only the last attachment. Either way, this current code doesn't move ANY attachments.
Private Sub cmdAddRecord_Click()
If MsgBox("Adding a new record will save the current form. You will not be able to edit this credit request. Would you like to continue?", vbQuestion + vbYesNo, "Save current record and open new form") = vbYes Then
MkDir "C:\Users\username\Desktop\IC Transfer Back Up Attachments\" & Me.txtRequestID & "-" & "Back Up Attachments" & " " & Format(Date, "MMDDYY")
DoCmd.RunCommand acCmdSaveRecord
Dim SaveFolder As String
SaveFolder = "C:\Users\username\Desktop\IC Transfer Back Up Attachments\" & Me.txtRequestID & "-" & "Back Up Attachments" & " " & Format(Date, "MMDDYY")
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set rsParent = CurrentDb.OpenRecordset("SELECT * FROM tblICTRequested")
Set rsChild = rsParent.Fields("BackUpAttachments").Value
Do Until rsChild.EOF
rsChild.Fields("FileData").SaveToFile SaveFolder
rsChild.MoveNext
Loop
DoCmd.RunCommand acCmdCloseWindow
DoCmd.OpenForm "frmICTRequested"
End If
End Sub
Most of this seems to make sense to me, but I'm not sure what I should put in the .Fields("FileData").SaveToFile line, since I don't have a field named "FileData" but I've tried all my existing fields to no avail.
For reference, here are some of the online links I have reviewed:
https://www.experts-exchange.com/questions/29005769/MS-Access-attachment-file.html
https://msdn.microsoft.com/en-us/library/office/ff191852.aspx
https://access-programmers.co.uk/forums/showthread.php?t=282135
Any tips? Much appreciated!
You're very close. I use a function like this:
Public Function SaveFileToDisk(FileName As String, FileData As DAO.Field2, Optional saveToFolder As String) As String
Dim templatePath As String
If saveToFolder = "" Or Not fso.FolderExists(saveToFolder) Then
saveToFolder = Environ("temp")
End If
templatePath = GetAvailableFileName(FileName, saveToFolder, True) 'A function to create a unique file name
FileData("FileData").SaveToFile templatePath
SaveTemplateToDisk = templatePath
End Function
It gets called like this:
Dim tempPath As String
Dim fileData as DAO.Field2
Dim folderToSaveTo as string
folderToSaveTo = "C:\some\folder"
set fileData = rsParent.Fields("BackUpAttachments")
tempPath = exporter.SaveTemplateToDisk("Name of file.ext", fileData , folderToSaveTo)
The attachment field is kind of like a recordset withing a field.
So with the help of someone, I changed the line:
Set rsParent = CurrentDB.OpenRecordset("SELECT * FROM tblICTRequested")
To:
Set rsParent = CurrentDB.OpenRecordset("SELECT * FROM tblICTRequested WHERE ID =" & Me.txtRequestedID)
This seems to be working perfectly for my purpose! Thank you to everyone who provided information!
I scan and save images with Wia using VBA in Microsoft Access.
The filepath to the saved image should be set as the value of the current cell.
I can't figure out how to do this but it seems like an easy task after learning how to use Wia.
Here is my current code that scans a document.
Function scanImage() As String
Dim imagePath As String
Dim folder As String
folder = "C:\Users\username\Pictures\scans\"
Dim tempName, obj
Set obj = CreateObject("Scripting.FileSystemObject")
tempName = obj.GetTempName
Dim filename
filename = Now
filename = Replace(filename, ".", "_")
filename = Replace(filename, " ", "_")
filename = Replace(filename, ":", "_")
imagePath = folder & filename & ".jpg"
Dim dev As Device
Dim wiaDialog As New WIA.CommonDialog
Dim wiaImage As WIA.ImageFile
Set dev = wiaDialog.ShowSelectDevice
Set wiaImage = wiaDialog.ShowAcquireImage
wiaImage.SaveFile (imagePath)
scanImage = imagePath
End Function
As comments have said - there's no cells in Access, and definitely no active cell.
You can add a record to a database using either of the methods below, but how do you plan on extracting that information again?
In Excel you just ask for the data in cell A1 for example, but in a database you generally ask for the data from a field or fields where another field on that same record is equal to some other values (either by supplying the 'other value' directly or by referencing other tables within the database).
So, for example, in your database you'd ask for the file paths of all files scanned on a certain date, or have some kind of description field to identify the file.
This would be written something like:
SELECT FilePath FROM Table2 WHERE DescriptionField = 'MyPhoto'
Anyway, the answer to get that single text string (imagepath) into a new record in a table is:
Sub InsertValueToTable()
Dim imagepath As String
imagepath = "<file path>"
'NB: The table name is 'Table2', the field (column) within the table is called 'FilePath'.
'One way to do it:
'DoCmd.RunSQL "INSERT INTO Table2(FilePath) VALUES ('" & imagepath & "')"
'Another way to do it:
Dim rst As dao.Recordset
Set rst = CurrentDb.OpenRecordset("Table2")
With rst
.AddNew
rst!FilePath = imagepath
.Update
.Close
End With
Set rst = Nothing
End Sub
Note - if you use a Text field in the database you'll be limited to 255 characters.
I have linked tables in an Access Database. I want to share this database and the associated excel workbooks with other users. I want to program a one-time use macro that the user will use the first time they use the database to relink the linked tables to the new user's local folder.
For example:
The linked table is current pulling the file from:
C:\Users\jane.doe\Desktop\Database Imports\Premier Account List.xlsx
When the new user (let's say their name is John Smith) relinks the table, it needs to read:
C:\Users\john.smith\Desktop\Database Imports\Premier Account List.xlsx
I basically want to change the file path from my OS Username to new user's OS Username. I already have the code to pull the OS Username, but I'm not sure how to code changing the file path. Here is the code to pull the OS UserName:
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
I am fairly new to VBA/Access, so if you could be as specific as possible with your answer, that would be great. Thanks in advanced!
The TableDef object has a Connect property that you need to change. It's a Read/Write String. You just need some string manipulation to make it how you want. Note that if they're moving the database file to the same path, you can just pull CurrentProject.Path rather than futzing with username APIs.
Sub ChangeTableLink()
Dim sNewPath As String
Dim lDbaseStart As Long
Dim td As TableDef
Dim sFile As String
Dim db As DAO.Database
'This is what we look for in the Connect string
Const sDBASE As String = "DATABASE="
'Set a variable to CurrentDb and to the table
Set db = CurrentDb
Set td = db.TableDefs("Fuel Pricing")
'Whatever your new path is, set it here
sNewPath = CurrentProject.Path & "\"
'Find where the database piece starts
lDbaseStart = InStr(1, td.Connect, sDBASE)
'As long as you found it
If lDbaseStart > 0 Then
'Separate out the file name
sFile = Dir(Mid(td.Connect, lDbaseStart + Len(sDBASE), Len(td.Connect)))
'Rewrite Connect and refresh it
td.Connect = Left(td.Connect, lDbaseStart - 1) & sDBASE & sNewPath & sFile
td.RefreshLink
End If
End Sub
I want to load the data from a comma delimited table into a temp table on sql server. I am using this code and it is working great. But since it is a "," delimited file, if any field in the file contains ',' then this code is not working. as in the replace function that "," is also replace. Any help
Imports System
Imports System.Data
Imports System.Math
Imports Microsoft.SqlServer.Dts.Runtime
Imports System.IO
Imports system.Data.OleDb
Imports Microsoft.SqlServer.DTSRuntimeWrap
Public Class ScriptMain
' The execution engine calls this method when the task executes.
' To access the object model, use the Dts object. Connections, variables, events,
' and logging features are available as static members of the Dts class.
' Before returning from this method, set the value of Dts.TaskResult to indicate success or failure.
'
' To open Code and Text Editor Help, press F1.
' To open Object Browser, press Ctrl+Alt+J.
Public Sub Main()
Dts.TaskResult = Dts.Results.Failure
Dim strFilePath As String = Dts.Variables("FilePath").Value.ToString
Dim strCurrentZipFile As String = Dts.Variables("CurrentZipFile").Value.ToString
Dim strConn As String = IO.Path.GetFileNameWithoutExtension(Dts.Variables("FilePath").Value.ToString)
Dim strFields() As String = Dts.Variables("FilePath").Value.ToString.Split(",".ToCharArray())
'Dts.Connections.Item(strConn).ConnectionString = strFilePath
Dts.Connections.Item("EmpInfo").ConnectionString = strFilePath
Dts.Variables("CurrentRawFile").Value = IO.Path.GetFileName(strCurrentZipFile)
' MsgBox(Dts.Variables("CurrentRawFile").Value)
Dts.TaskResult = Dts.Results.Success
' The execution engine calls this method when the task executes.
' To access the object model, use the Dts object. Connections, variables, events,
' and logging features are available as static members of the Dts class.
' Before returning from this method, set the value of Dts.TaskResult to indicate success or failure.
'
' To open Code and Text Editor Help, press F1.
' To open Object Browser, press Ctrl+Alt+J.
Dim cm As ConnectionManager
Dim con As OleDbConnection
Dim cmd As New OleDbCommand()
' myADONETConnection = DirectCast(TryCast(Dts.Connections("Polldata").AcquireConnection(Dts.Transaction), SqlConnection), SqlConnection)
' MsgBox(myADONETConnection.ConnectionString, "PollData")
Dim line1 As String = ""
'Reading file names one by one
Dim SourceDirectory As String = Dts.Variables("FilePath").Value.ToString
cm = Dts.Connections("Polldata")
Dim cmParam As Wrapper.IDTSConnectionManagerDatabaseParameters90
cmParam = CType(cm.InnerObject, Wrapper.IDTSConnectionManagerDatabaseParameters90)
con = CType(cmParam.GetConnectionForSchema(), OleDb.OleDbConnection)
cmd.Connection = con
'MsgBox(Dts.Variables("FilePath").Value.ToString)
' TODO: Add your code here
' Dim fileEntries As IO.DirectoryInfo = New IO.DirectoryInfo(SourceDirectory)
' MsgBox(fileEntries)
' For Each fileName As String In fileEntries.GetFiles()
' do something with fileName
' MsgBox(fileName)
Dim columname As String = ""
'Reading first line of each file and assign to variable
Dim file2 As New System.IO.StreamReader(Dts.Variables("FilePath").Value.ToString) '(fileName)
'Dim filenameonly As String = (((fileName.Replace(SourceDirectory, "")).Replace(".txt", "")).Replace("\", ""))
'Create a temporary table
line1 = (" IF EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].tmp_empinfo" & "') AND type in (N'U'))DROP TABLE [dbo].tmp_empinfo" & " Create Table dbo.tmp_empinfo" & "(" & file2.ReadLine().Replace(",", " VARCHAR(100),") & " VARCHAR(100))").Replace(".txt", "")
file2.Close()
' MsgBox(line1.ToString())
cmd.CommandText = line1
cmd.ExecuteNonQuery()
'MsgBox("TABLE IS CREATED")
'Writing Data of File Into Table
Dim counter As Integer = 0
Dim line As String = ""
Dim SourceFile As New System.IO.StreamReader(Dts.Variables("FilePath").Value.ToString) '(fileName)
While (InlineAssignHelper(line, SourceFile.ReadLine())) IsNot Nothing
If counter = 0 Then
columname = line.ToString()
' MsgBox("INside IF")
Else
' MsgBox("Inside ELSE")
Dim query As String = "Insert into dbo.tmp_empinfo" & "(" & columname & " VALUES('" & line.Replace(",", "','").Replace("""", "") & "')"
'Dim query As String = "Insert into dbo.tmp_empinfo" & "(" & columname & " VALUES(" & strFields.ToString & ")"
' Dim query As String = "BULK INSERT dbo.tmp_empinfo FROM '" & strFilePath & "' WITH " & " ( " & " FIELDTERMINATOR = '|', " & " ROWTERMINATOR = '\n' " & " )"
MsgBox(query.ToString())
cmd.CommandText = query
cmd.ExecuteNonQuery()
End If
"I want to load the data from a comma delimited table into a temp table on sql server". Are you saying you basically already have a column in a table in a database that contains the data in a comma separated list? For instance,
SELECT column_name
FROM schema.table
outputs something like some_data, more_data, even_more_data, even,more_data? And your problem is that the text isn't quoted, so some of the rows end up having extra phantom columns when you try to load it in your destination?
If this is the problem, then I would recommend introducing quoted identifiers in your source data before it is loaded into your source table. Meaning, whatever process that imports the data into that table needs to be fixed so that you don't have to deal with this kind of problem. If that can't be done, then you will have to build logic into your script component or sql select statement to split it out appropriately. The only way to fix the problem at this point would be to fix the data.
Did I misunderstand your intent or does this answer your question?
I'm trying to use a script I found on the internet to allow the bulk creation of new user accounts in Active Directory using VBScript and a CSV file. I'm not using CSVDE b/c this script will also create passwords. I keep encountering this error when running the code I cannot figure it out. Can anyone help?
'*********************************************************************
' Script: createUsersFromCSV.vbs *
' Creates new user accounts in Active Directory from a CSV file. *
' Input: CSV file with layout logonname,firstname,lastname,password *
' *
'*********************************************************************
Option Explicit
Dim sCSVFileLocation
Dim sCSVFile
Dim oConnection
Dim oRecordSet
Dim oNewUser
' Variables needed for LDAP connection
Dim oRootLDAP
Dim oContainer
' Holding variables for information import from CSV file
Dim sLogon
Dim sFirstName
Dim sLastName
Dim sDisplayName
Dim sPassword
Dim nPwdLastSet
Dim nUserAccountControl ' Used to enable the account
Dim sDomain
Dim sCompany
Dim sPhone
Dim sEmail
Dim sDescription
Dim NumChar, Count, strRdm, intRdm
Dim fso, f, fso1, f1
'* Modify this to match your company's AD domain
sDomain="mydomain.local"
'* Input file location
sCSVFileLocation = "C:\Documents and Settings\Administrator\Desktop\" 'KEEP TRAILING SLASH!
'* Full path to input file
sCSVFile = sCSVFileLocation&"newusers.csv"
' Commands used to open the CSV file and select all of the records
set oConnection = createobject("adodb.connection")
set oRecordSet = createobject("adodb.recordset")
oConnection.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & _
sCSVFileLocation & ";Extended Properties=""text;HDR=NO;FMT=Delimited"""
oRecordSet.open "SELECT * FROM " & sCSVFile ,oConnection
' Create a connection to an Active Directory OU container.
Set oRootLDAP = GetObject("LDAP://rootDSE")
Set oContainer = GetObject("LDAP://ou=Test," & _
oRootLDAP.Get("defaultNamingContext"))
on error resume next
do until oRecordSet.EOF ' Reads the values (cells) in the sInputFile file.
' --------- Start creating user account
' Read variable information from the CSV file
' and build everything needed to create the account
sLogon = oRecordSet.Fields.Item(0).value
sFirstName = oRecordSet.Fields.Item(1).value
sLastName = oRecordSet.Fields.Item(2).value
sDisplayName = sFirstName&" "&sLastName
sPassword = oRecordSet.Fields.Item(3).value
' Build the User account
Set oNewUser = oContainer.Create("User","cn="&sFirstName&" "&sLastName)
oNewUser.put "sAMAccountName",lcase(sLogon)
oNewUser.put "givenName",sFirstName
oNewUser.put "sn",sLastName
oNewUser.put "UserPrincipalName",lcase(SLogon)&"#"&sDomain
oNewUser.put "DisplayName",sDisplayName
oNewUser.put "name",lcase(sLogon)
' Write this information into Active Directory so we can
' modify the password and enable the user account
oNewUser.SetInfo
' Change the users password
oNewUser.SetPassword sPassword
oNewUser.Put "pwdLastSet", 0
' Enable the user account
oNewUser.Put "userAccountControl", 512
oNewUser.SetInfo
objFile.Close
'*******************
oRecordset.MoveNext
Loop
'*******************
' Used only for debugging
'if err.number = -2147019886 then
' msgbox "User logon " & sLogon & "already exists"
'End If
' --------- End of user account creation
Here is where the error is occuring, line 51 char 1:
oRecordSet.open "SELECT * FROM " & sCSVFile ,oConnection
Maybe sCSVFile contains special characters and therefore must be escaped like this:
oRecordSet.open "SELECT * FROM [" & sCSVFile & "]", oConnection
I hope it helps.