I have a button in MS access to export an OLE word document.
Private Sub Command25_Click()
Set OLEobj = Me.POLICY_OLE
OLEobj.SaveAs Me.TRANSACTION_TYPE.Value & Me.TRANSACTION_NUMBER.Value & ".doc"
Set OLEobj = Nothing
End Sub
This is working fine but I would like to define the file path say
C:\Me.TRANSACTION_TYPE.Value & Me.TRANSACTION_NUMBER.Value & ".doc"
Related
I have a number of Powerpoint files in a folder (around 10 or so) and am looking to create VBA in Powerpoint that will PDF all of them. What I have appears to work, but it PDFs most of the files but not all of them. No idea why - the ppts it misses each time will vary.
I'm running the below 'OpenPPts' which is calling the the sub 'CreatePdfs'. Calling the CreatePdfs as a separate sub is ideal for me as I can change this to complete other tasks.
Any help would be much appreciated.
Public Sub OpenPpts()
Dim strFileName As String
Dim strFolderName As String
Dim PP As Presentation
Dim oSld As Slide
On Error Resume Next
strFolderName = "C:\my ppt files\"
strFileName = Dir(strFolderName & "\*.pptx")
Do While Len(strFileName) > 0
Set PP = Presentations.Open(strFolderName & "\" & strFileName)
'enter the vba to call below
Call CreatePdf
PP.Save
PP.Close
strFileName = Dir
Loop
End Sub
Sub CreatePdf()
'saves opens PPT as PDF in the same folder and applies same name.
ActivePresentation.ExportAsFixedFormat ActivePresentation.Path & "\" & ActivePresentation.Name & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint
End Sub
I am trying to import multiple .txt files from a directory into an Access table using VBA.
I have code that currently works that imports the data and moves the files to an archive directory.
What I need to do is add the first part of the filename as field in the table, namely the date.
The file format is MMDDYYYY_LbxReport.txt (ex 02082022_LbxReport.txt)
Here is the code that I have working, and I commented out what I tried to add to fix my problem:
Private Sub Command9_Click()
On Error GoTo bImportFiles_Click_Err
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
'Dim dteEntry As Variant 'added this variant for use in UPDATE cmd
Dim strFolderPath As String
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder("\\*****************\upload\SSDTestLBXa\")
Set objFiles = objFolder.files
For Each objF1 In objFiles
If Right(objF1.Name, 11) = "xReport.txt" Then 'LBX level report capture
'dteEntry = Left(objF1.Name, 8)
'dteEntry = Left(dteEntry, 2) & "/" & Mid(dteEntry, 3, 2) & "/" & Right(dteEntry, 4) 'added to reformat into standard date format
DoCmd.TransferText acImportDelim, "lbxlevelspecs", "lbxlevel", strFolderPath & objF1.Name, False
'CurrentDb.Execute "Update lbxlevel" & "Set EntryDate=" & dteEntry & "", [] 'getting syntax errors here
Name strFolderPath & objF1.Name As "\\**************\upload\SSDTestLBXa\Archive\" & objF1.Name 'Move the files to the archive folder
End If
Next
Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing
'Call Site_level
MsgBox ctr & "All volumes imported", , "Volume Import"
bImportFiles_Click_Exit:
Exit Sub
bImportFiles_Click_Err:
MsgBox Err.Number & " " & Err.Description
Resume bImportFiles_Click_Exit
End Sub
I saw a similar thread for this question, but I can't get the syntax right, and the OP's code was very different from what I have that's working so far.
Any help would be greatly appreciated!
This is how you would construct the update statement:
Public Sub doit()
Dim dteEntry As Variant
dteEntry = Left("02142024_SomeName.txt", 8)
dteEntry = Left(dteEntry, 2) & "/" & Mid(dteEntry, 3, 2) & "/" & Right(dteEntry, 4) 'added to reformat into standard date format
CurrentDb.Execute "ALTER TABLE lbxlevel ADD EntryDate DATETIME"
CurrentDb.Execute "Update lbxlevel " & "Set EntryDate='" & dteEntry & "'"
End Sub
Because it needs apace before 'SET', and quotation marks around the date.
EDIT: I added the ALTER TABLE, this tests successfully on my side.
I've tried using this method to export an ole object (image) but it keeps saying run-time error 438 object doesn't support this property or method on this line:
OLEobj.SaveAs "Test" & Me.ID.Value & ".jpg"
Original Code:
Private Sub CmdExport_Click()
Set OLEobj = Me.OLEField
OLEobj.SaveAs "Test" & Me.ID.Value & ".jpg"
Set OLEobj = Nothing
End Sub
I wanted to copy a local file to sharepoint library using VBA by clicking an image. Right now seems like I'm unable to check for Folder & Files on SharePoint.
As every time I ran the code(by clicking an image in excel), it returns unable to find the file in SharePoint. And stops at returning the MsgBox Sorry there's no such Folder......
I tried mapping drive, it works perfectly fine, but not an options because end-user need to map the drive by themselves.
So now I'm looking to connecting to SharePoint using the link.
If I copy the SharePointLink to IE & Chrome using \, it works fine. But if I uses /, IE is unable to find the link.
UPDATE
If I uses \ after few tries, IE, will open up the file path in NetWork. Chrome will show the file path on chrome page. Why is this happening?????
The authentication is using windows authentication, so not an issue.
This is my code
Sub imgClicked()
Dim SharePointLib As String
Dim MyPath As String
Dim folderPath As String
Dim objNet As Object
Dim FSO As Object
Dim copyPath As String
Dim copyFilePath As String
folderPath = Application.ThisWorkbook.path
MyPath = Application.ThisWorkbook.FullName
SharePointLib = "//company.com/sites/MS/10%20Mg%20Review/"
' create new folder to store the file
copyPath = folderPath + "\copyPath\"
If Not FolderExists(copyPath) Then
FolderCreate (copyPath)
ElseIf Not FolderExists(SharePointLib) Then
MsgBox "Sorry there's no such folder. Folder Path: " & vbNewLine & vbNewLine & SharePointLib & ""
Exit Sub
End If
fileName = "hello.xlsm"
'Copy current excel file and save at the new folder created
ThisWorkbook.SaveCopyAs copyPath & fileName
MsgBox "Save Copy As: " + copyPath & filseName & vbNewLine & vbNewLine & "The file will be uploaded to this address: " + SharePointLib & fileName
' Check whether the file exist in the directory
' If exist error message
' else copy the file from copyPath then paste at the SharePoint directory
If Not Dir(SharePointLib & fileName, vbDirectory) = nbNullString Then
MsgBox "Sorry file already exist!"
Else
Call FileCopy(copyPath & fileName, SharePointLib & fileName)
MsgBox "File has being successfuly created in SharePoint!"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If Right(copyPath, 1) = "\" Then
copyPath = Left(copyPath, Len(copyPath) - 1)
End If
If FSO.FolderExists(copyPath) = False Then
MsgBox copyPath & " doesn't exist"
Exit Sub
End If
FSO.DeleteFolder copyPath
MsgBox "Folder has being deleted successfully!"
End Sub
Function for checking if folder exists
Function FolderExists(ByVal path As String) As Boolean
FolderExists = False
Dim FSO As New FileSystemObject
If FSO.FolderExists(path) Then FolderExists = True
End Function
Function for creating Folder
Function FolderCreate(ByVal path As String) As Boolean
FolderCreate = True
Dim FSO As New FileSystemObject
try:
If FSO.FolderExists(path) Then
Exit Function
Else
On Error GoTo catch
FSO.CreateFolder path
Debug.Print "FolderCreate: " & vbTab & path
Exit Function
End If
catch:
MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
FolderCreate = False
Exit Function
End Function
Any help and suggestions are appreciated. Let me know if more info is needed. Thanks in advance.
Ensure the WebClient service is running. You can start the WebClient service through code, or you could set the startup type to automatic.
With the WebClient service running, your folder/file tests will work as expected.
Edit: Additionally, if you map the sharepoint url to a drive letter, Windows will start the WebClient service.
Sub mapPath(str_drive as string, str_path as string)
If Not Len(str_drive) = 1 Then Exit Sub
Dim wso As Object
Set wso = CreateObject("WScript.Network")
wso.MapNetworkDrive str_drive & ":", str_path, False
End Sub
VBA Powerpoint. How can i set environment current directory?
I also tried this code:
Sub test()
Dim sPath As String
sPath = ActiveWorkbook.Path
MsgBox sPath
End Sub
But is says: Object required
Please help me to make it work ...
Tim has provided the answer. The file path of the active presentation is stored in the property, ActivePresentation.Path. If the presentation file has not been saved yet this property will contain an empty string. To test this out you could use something like:
Sub test()
Dim sPath As String
sPath = ActivePresentation.Path
If Len(sPath) > 0 Then
MsgBox ActivePresentation.Name & vbNewLine & "saved under" & vbNewLine & sPath
Else
MsgBox "File not saved"
End If
End Sub
Note that this is a read-only property. You can't set this variable.
https://learn.microsoft.com/en-us/office/vba/api/powerpoint.presentation.path